Macro para transferir archivos a un sitio FTP
Recientemente tuve un caso donde luego de realizar unos cálulos automatizados en Excel, el resultado debía transferirse a un sitio FTP. El desafío entonces es si es posible crear una manera automatizada de transferir estos archivos al sitio remoto.
Encontré varios recursos en línea y gracias a ellos desarrollé la siguiente solución
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 |
Sub UploadFile() Dim strDirectoryList As String Dim lStr_Dir As String Dim lInt_FreeFile01 As Integer Dim lInt_FreeFile02 As Integer Dim nn As String On Error GoTo Err_Handler lStr_Dir = ThisWorkbook.Path lInt_FreeFile01 = FreeFile lInt_FreeFile02 = FreeFile nn = "ftpcom" strDirectoryList = lStr_Dir & "\" & nn '' Borrar archivo de cierre If Dir(strDirectoryList & ".out") <> "" Then Kill (strDirectoryList & ".out") '' Crear archivo de texto con instrucciones FTP Open strDirectoryList & ".txt" For Output As #lInt_FreeFile01 Print #lInt_FreeFile01, "!REM upload files" Print #lInt_FreeFile01, "open ftp.agiltools.com" Print #lInt_FreeFile01, "USER suusuarioaqui supasswordaqui" Print #lInt_FreeFile01, "binary" Print #lInt_FreeFile01, "!REM turn off interactive mode" Print #lInt_FreeFile01, "prompt" Print #lInt_FreeFile01, "mput """ & ThisWorkbook.Path & "\project.XML""" Print #lInt_FreeFile01, "bye" Close #lInt_FreeFile01 '' Crear archivo Batch Open strDirectoryList & ".bat" For Output As #lInt_FreeFile02 Print #lInt_FreeFile02, "ftp -n -s:""" & strDirectoryList & ".txt""" Print #lInt_FreeFile02, "Echo ""Complete"" > """ & strDirectoryList & ".out""" Close #lInt_FreeFile02 PathCrnt = ActiveWorkbook.Path Shell ("""" & PathCrnt & "\" & nn & ".bat""") Application.Wait (Now + TimeValue("0:00:03")) '' Clean up files If Dir(strDirectoryList & ".bat") <> "" Then Kill (strDirectoryList & ".bat") If Dir(strDirectoryList & ".out") <> "" Then Kill (strDirectoryList & ".out") If Dir(strDirectoryList & ".txt") <> "" Then Kill (strDirectoryList & ".txt") bye: Exit Sub Err_Handler: MsgBox "Error : " & Err.Number & vbCrLf & "Description : " & Err.Description, vbCritical Resume bye End Sub |
En síntesis es una macro que crea un archivo de texto con las instrucciones en sintaxis FTP, luego crea un archivo Batch que transfiere instrucciones MS-DOS siguiendo cada una de las líneas del archivo de texto. Al finalizar, crea un archivo con extensión .out donde se confirma la transferencia.
Nótese que es necesario cambiar el código para agregar el usuario y password correcto. En ocasiones el sitio FTP no requiere password pues la conexión es anónima. Si este es el caso, simplemente remueva esas dos líneas del código.
El siguiente video muestra el programa en ejecución.
could you please give me a suggestion for me to upload the Thisworkbook to the ftp server but above code is would fine , where i have to make changes can mention for us
Hello jwala
Plese change lines 21, 22 and 26:
Print #lInt_FreeFile01, "open http://ftp.agiltools.com" -------> ftp destination address
Print #lInt_FreeFile01, "USER suusuarioaqui supasswordaqui" -------> username and password for the ftp site
Print #lInt_FreeFile01, "mput """ & ThisWorkbook.Path & "\project.XML""" -------> path to the file to upload
Hola,
Gracias por el aporte.
¿Podrías por favor señalar qué elementos debemos sustituir en nuestro código para reemplazarlos por nuestro fichero a transferir, nuestro ftp, etc..?
Gracias y saludos.
Hola Mauro, gracias por tu comentario.
Debes sustituir valores en las líneas 21, 22 y 26 del código así:
Print #lInt_FreeFile01, "open http://ftp.agiltools.com" -------> Ingresa aquí el sitio ftp de destino
Print #lInt_FreeFile01, "USER suusuarioaqui supasswordaqui" -------> sustituye estos datos por el usuario y la contraseña
Print #lInt_FreeFile01, "mput """ & ThisWorkbook.Path & "\project.XML""" -------> ruta del archivo a cargar.
Hi Alvaro,
Many thanks for this code, it will really help a lot.
I just need one more information: if I want to upload a file into a folder inside de ftp server, where in the code should I declare it.
Regards!
How can I upload a file to a subfolder in ftp server?
Regards
Hola,
Que sentido tiene la linea:
Application.Wait (Now + TimeValue("0:00:03"))
?
Esperar a que el archivo se transfiera completamente?
Saludos
Si, correcto. El valor del delta puede ajustarse según el caso.
Buenos días,
Cómo se gestionaría si en el ftp ya hay un archivo con ese nombre y queremos sobreescribirlo?
Muchas gracias.
¡Hola! Gracias por el ejemplo... todavia aun tirinho una Duda: ¿ podrías decirme si es possible cambiar para el uso con sftp y login con archivo *.ppk? Gracias, abrazo
Antonio Arruda
Amigo, não consigo executar essa Script, tentei de várias formas, mas não consigo; não consegue acessar o FTP destin... poderia me ajudar?
Agradeço desde já!!!
Hi Gil, Can you provide me the xlsm file itself
Ola, boa tarde, nao consegui conectar nem enviar o arquivo para o ftp esta dando erro de arquivo nao encontrato
Hola alvaro, sabes que debo modificar para que suba toda una carpeta con archivos .pdf
Muchas gracias por el aporte,, ¿podría por favor indicare cómo se puede hacer relación a un archivo ppk en vez de una contraseña?
Todo muy bien hasta que me encuentro con la necesidad de agregar el nuevo fichero a /web/centrodedescargas/, por ejemplo es decir no lo quiero en la raiz sino en una carpeta o subcarpeta como podría modificar el código para que esto pueda ocurrirlo?
Hola, por si a alguien le interesa he estado buscando información sobre este tema y al final he conseguido que me funcionase el código. Tenia dos problemas; por un lado necesitaba (como otros compañeros) cambiar el directorio raíz del FTP, por otro y algo mas peliagudo; en cuanto tengas cualquier espacio en las rutas que utilizas ya no funciona nada.
Así que he añadido un par de líneas y el código me queda así:
Sub UploadFileNABIL()
Dim strDirectoryList As String
Dim lStr_Dir As String
Dim lInt_FreeFile01 As Integer
Dim lInt_FreeFile02 As Integer
Dim nn As String
Dim Archivo As String
Dim StrQuote As String
StrQuote = Chr$(34) 'con las colillas para colocar las rutas entre ellas y que todo funcione
Archivo = Application.GetOpenFilename
On Error GoTo Err_Handler
lStr_Dir = ThisWorkbook.Path
lInt_FreeFile01 = FreeFile
lInt_FreeFile02 = FreeFile
nn = "ftpcom"
strDirectoryList = lStr_Dir & "\" & nn
'' Borrar archivo de cierre
If Dir(strDirectoryList & ".out") "" Then Kill (strDirectoryList & ".out")
'' Crear archivo de texto con instrucciones FTP
Open strDirectoryList & ".txt" For Output As #lInt_FreeFile01
Print #lInt_FreeFile01, "!REM upload files"
Print #lInt_FreeFile01, "open tuserviror.net" 'aquí pones la dirección de tu servidor
Print #lInt_FreeFile01, "USER tunombredeusuario tucontraseña" 'aquí sustituye por tu nombre de usuario y contraseña
Print #lInt_FreeFile01, "binary"
Print #lInt_FreeFile01, "!REM turn off interactive mode"
Print #lInt_FreeFile01, "prompt"
Print #lInt_FreeFile01, "cd /html/Fotos" 'En esta línea pones despues de cd ) la ruta del directorio de la carpeta FTP
Print #lInt_FreeFile01, "mput " & StrQuote & Archivo & StrQuote 'El archivo entre comillas...
Print #lInt_FreeFile01, "bye"
Close #lInt_FreeFile01
'' Crear archivo Batch
Open strDirectoryList & ".bat" For Output As #lInt_FreeFile02
Print #lInt_FreeFile02, "ftp -n -s:" & StrQuote & strDirectoryList & ".txt" & StrQuote 'El directorio entre comillas...
Print #lInt_FreeFile02, "Echo ""Complete"" > " & StrQuote & strDirectoryList & ".out" & StrQuote
Close #lInt_FreeFile02
PathCrnt = ThisWorkbook.Path
Shell (StrQuote & PathCrnt & "\" & nn & ".bat" & StrQuote), vbNormalFocus 'y el comando Shell entre comillas.
Application.Wait (Now + TimeValue("0:00:03"))
'' Clean up files
If Dir(strDirectoryList & ".bat") "" Then Kill (strDirectoryList & ".bat")
If Dir(strDirectoryList & ".out") "" Then Kill (strDirectoryList & ".out")
If Dir(strDirectoryList & ".txt") "" Then Kill (strDirectoryList & ".txt")
bye:
Exit Sub
Err_Handler:
MsgBox "Error : " & Err.Number & vbCrLf & "Description : " & Err.Description, vbCritical
Resume bye
End Sub
Espero que os funcione y os sirva, me ha costado lo mio ya que solo soy un aficionado.
Un saludo