Hola a todos, tratando de actualizar un archivo de excel cada vez hago cambios.
No puedo hacer funcionar estos códigos que se encuentran facilmente en la red.
Se conectan pero no llegan a transferir el archivo de prueba.
Cualquier sugerencia o código superior sera bienvenido
Sub Get_File_From_FTP()
Dim FTP As INet
HostURL = "MiDominio.com"
FileSource = ThisWorkbook.Path & "\test.html"
FileDestination = "/home/MiDominio"
'Create New instance of Object and Assign the Parameters
Set FTP = New INet
With FTP
.URL = "ftp://ftp.MiDominio.com/"
.Protocol = icFTP
'Replace with your Login and Password Below. Many FTP servers allow Anonymous access with below credentials
.UserName = "MiDominio"
.Password = "ClaveDeMiDominio"
.AccessType = icUseDefault
'Use "Get" to Download and "Put" Option to Upload File to FTP Server
.Execute .URL, "Put" & FileSource & " " & FileDestination
End With
Do While FTP.StillExecuting
DoEvents
Loop
'Status of FTP through Voice Message
Application.Speech.Speak "Process Completed;" & FTP.ResponseInfo
If FTP.ResponseCode = 0 Then
'SomeTime FTP steps will execute successfully, but file will not be there in Destination path
'Search for the file in the Path mentioned in this Message Box
MsgBox "File is Copied to :" & VBA.CurDir
End If
Set FTP = Nothing
End Sub
Private Declare Function InternetOpen _
Lib "wininet.dll" _
Alias "InternetOpenA" _
(ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long
'Connect to the network
Private Declare Function InternetConnect _
Lib "wininet.dll" _
Alias "InternetConnectA" _
(ByVal hInternetSession As Long, _
ByVal sServerName As String, _
ByVal nServerPort As Integer, _
ByVal sUsername As String, _
ByVal sPassword As String, _
ByVal lService As Long, _
ByVal lFlags As Long, _
ByVal lContext As Long) As Long
'Get a file using FTP
Private Declare Function FtpGetFile _
Lib "wininet.dll" _
Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
'Send a file using FTP
Private Declare Function FtpPutFile _
Lib "wininet.dll" _
Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
'Close the Internet object
Private Declare Function InternetCloseHandle _
Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Sub UploadFTP()
Dim hostFile As String
Dim INet As Long
Dim INetConn As Long
Dim Password As String
Dim RetVal As Long
Dim ServerName As String
Dim Success As Long
Dim UserName As String
Const ASCII_TRANSFER = 1
Const BINARY_TRANSFER = 2
ServerName = "MiDominio.com"
UserName = "MiDominio"
Password = "ClaveDeMiDominio"
localFile = ThisWorkbook.Path & "\test.html"
hostFile = "/home/MiDominio.com"
RetVal = False
INet = InternetOpen("MyFTP Control", 1&, vbNullString, vbNullString, 0&)
If INet > 0 Then
INetConn = InternetConnect(INet, ServerName, 0&, UserName, Password, 1&, 0&, 0&)
If INetConn > 0 Then
Success = FtpPutFile(INetConn, localFile, hostFile, BINARY_TRANSFER, 0&)
RetVal = InternetCloseHandle(INetConn)
End If
RetVal = InternetCloseHandle(INet)
End If
If Success <> 0 Then
MsgBox ("Upload process completed")
Else
MsgBox "FTP File Error!"
End If
End Sub
¿tus nombres de archivo contienen espacios?
esa línea concatena los nombres y los separa con un espacio si hay espacios en tu ruta de origen o de destino dará problemas
.Execute .URL, "Put" & FileSource & " " & FileDestination
También parece que falta un espacio detrás del PUT para separarlo del nombre del archivo
Aparte de esto, ¿obtienes algún error? ¿tienes más información aparte de que no funciona?
------
Ya sé Excel, pero necesito más.
Probe varias horas, cientos de combinaciones de directorios, agregue espacio en put y quité entre rutas .Execute .URL, "Put " & FileSource & "" & FileDestination
Conecta pero no transfiere.
Primer mensaje de transferencia exitosa con el siguiente mensaje local File is copied to: C:\misdocs supongo que por este código VBA.CurDir y luego entra en la etiqueta de error con mensaje de error:0 sin descripción. Sigo probando. Gracias y saludos.
El primer código no pude hacerlo subir archivos. El segundo código cambiando parametros de esta forma funciona correctamente.
localFile = ThisWorkbook.Path & "\test.html"
hostFile = "/MiDominio/test.html"
Agradezco la ayuda!