La cuestion es que los token de dropbox que creo ahora caducan a las 4 horas, y por mas que busco no encuentro solucion.
No me queda claro si es que hago algo mal a crear el token, en principio casi seguro que este paso es correcto.
O es que hay que modificar algo en el codigo por algo que dropbox a cambiado el la api.
Public Function SubirDropbox(varToken, varDirectorioDropbox, varArchivo As String)
On Error GoTo Err_SubirDropbox
Dim req As Object
Dim arg As String
Dim result As Variant 'Si ponemos option explicit hay que declararla como Variant
result = FRB(varArchivo) 'Pasamos a binario
arg = "{""path"":""" & varDirectorioDropbox & """,""mode"":""add"",""autorename"":false,""mute"":true}"
'arg = "{""path"":""" & varfile & """,""mode"":""overwrite"",""autorename"":false,""mute"":true}"
Set req = CreateObject("WINHTTP.WinHTTPRequest.5.1")
'ResolveTimeout,ConnectTimeout,SendTimeout,ReceiveTimeout
req.SetTimeouts 30000, 600000, 600000, 600000 'Tiempo en milisegundos para temas de tiempos de conexion y no se corte al subir un archivo
req.Open "POST", "https://content.dropboxapi.com/2/files/upload", False
req.setRequestHeader "Authorization", "Bearer " & varToken 'Hay que poner el token de la aplicacion de dropbox en la variable
req.setRequestHeader "Content-Type", "application/octet-stream"
req.setRequestHeader "Dropbox-API-Arg", arg
req.setRequestHeader "User-Agent", "api-explorer-client"
req.send (result)
If req.status = 200 Then
Debug.Print req.responseText
MsgBox req.responseText, , "OK, archivo subido correctamente a Dropbox"
Else
MsgBox req.status & ": " & req.statusText
Debug.Print req.responseText
MsgBox req.responseText
End If
Exit_SubirDropbox:
Exit Function
Err_SubirDropbox:
If Err.Number = 76 Then
MsgBox Err.Description & " ,error 76.", vbExclamation, "La ruta del archivo a subir no es correcta."
Else
MsgBox Err.Description
End If
'MsgBox Err.Description
Resume Exit_SubirDropbox
End Function
Public Function FRB(ByVal sRuta As String) As Byte() 'Pasamos directorio a binario
Dim b() As Byte
Open sRuta For Binary As #1
ReDim b(FileLen(sRuta) - 1) '''''****ESTE -1 ES LA SOLUCIÓN PARA QUE NO CORROMPA LOS ARCHIVOS******RESTARLE UN BYTE
Get #1, , b
Close #1
FRB = b
End Function