Hola,
tengo un script hecho para mandar archivos por ftp y me funciona perfectamente.
Es este:
Código:
'****************FTP Upload
'Upload a file/folder to an FTP server
Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
MiMes=Month(Now)
strDate2=ucase(MonthName(MiMes))
strDate = Day(Date()) &"_"& ucase(MonthName(MiMes))
'Path to file or folder to upload
path = "C:\archivos\archivoftp_"&strDate&".csv"
FTPUpload1
Sub FTPUpload1
if Time()>TimeValue("04:00:00") and Time()<TimeValue("04:45:00")Then
MiMes=Month(Now)
strDate2=ucase(MonthName(MiMes))
strDate = Day(Date()) &"_"& ucase(MonthName(MiMes))
On Error Resume Next
'Copy Options: 16 = Yes to All
Const copyType = 16
'FTP Wait Time in ms
waitTime = 80000
FTPUser = "user"
FTPPass = "pass"
FTPHost = "ftphost"
FTPDir = "/archivos"
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & FTPDir
Set objFTP = oShell.NameSpace(strFTP)
'Make new folder on FTP site
'objFTP.NewFolder "FTP Backup"
'Upload single file
If objFSO.FileExists(path) Then
Set objFile = objFSO.getFile(path)
strParent = objFile.ParentFolder
Set objFolder = oShell.NameSpace(strParent)
Set objItem = objFolder.ParseName(objFile.Name)
Wscript.Echo "Uploading file " & objItem.Name & " to " & strFTP
objFTP.CopyHere objItem, copyType
End If
'Upload all files in folder
If objFSO.FolderExists(path) Then
'Code below can be used to upload entire folder
Set objFolder = oShell.NameSpace(path)
Wscript.Echo "Uploading folder " & path & " to " & strFTP
objFTP.CopyHere objFolder.Items, copyType
End If
If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Description
End If
'Wait for upload
WScript.Sleep waitTime
End if
End Sub
Ahora necesito hacerlo para mandar archivos por ftps tcp/990 pero todavía no lo he conseguido, a ver si recibo una ayudita!
Qué tengo que cambiar de este script para poder subir por ftps tcp/990 ?
gracias
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & FTPDir
Ahí haces una petición ftp usando el puerto estándar
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & ":990" & FTPDir
Ahí especificas un puerto
Al final el estándar es:
servicio://usuario:pass@maquina.dominio:puerto/directorio/fichero.extension
Hola,
en primer lugar muchas gracias por tu ayuda pero no me funciona lo que me has puesto.
He probado también con:
strFTP = "ftps://" & FTPUser & ":" & FTPPass & "@" & FTPHost & ":990" & FTPDir
POniendo ftps en vez de fpt pero tampoco ha funcionado.
Entonces quizas deberias buscar otro código que haga la peticion de otra forma, ya que por petición de navegador creo que es esa la unica forma de cambiar el puerto. A ver si alguien sabe
Gracias. A ver si alguien más me puede ayudar. Saludos.
HOLA!!!
Te dejo una funcion mia con winsocks virtuales ;)
No me culpen por usar magia negra en VBS >:D
'FTP
Dim FTPData
Dim FTPCOMPLETE
Dim W1
Dim W2
'/FTP
Set W1 = WScript.CreateObject("MSWINSOCK.Winsock", "W1_")
Set W2 = WScript.CreateObject("MSWINSOCK.Winsock", "W2_")
Call FTPUpload(FTPServer, FTPPort, FTPUser, FTPPass, SPath, SFile)
Set W1 = Nothing
Set W2 = Nothing
Function FTPUpload(FTPServer, FTPPort, FTPUser, FTPPass, SPath, SFile)
W1.RemoteHost = FTPServer
W1.RemotePort = FTPPort
W1.Connect
If WaitResponse Then Exit Function
If FTPCODE <> 220 Then Exit Function
FTPData = ""
W1.SendData "USER " & FTPUser & vbCrLf
If WaitResponse Then Exit Function
If FTPCODE <> 331 Then Exit Function
FTPData = ""
W1.SendData "PASS " & FTPPass & vbCrLf
If WaitResponse Then Exit Function
If FTPCODE <> 230 Then Exit Function
FTPData = ""
W1.SendData "PASV" & vbCrLf
If WaitResponse Then Exit Function
If FTPCODE <> 227 Then Exit Function
Dim Aux
Aux = Split(FTPData, ",")
FTPDataPort = (Aux(UBound(Aux) - 1) * 256) + Left(Aux(UBound(Aux)), InStr(Aux(UBound(Aux)), ")") - 1)
FTPDataIP = Trim(Replace(Right(Aux(0), 3), "(", vbNullString)) & "." & Aux(1) & "." & Aux(2) & "." & Aux(3)
FTPData = ""
W1.SendData "STOR " & SFile & vbCrLf
W2.RemotePort = FTPDataPort: W2.RemoteHost = FTPDataIP
W2.Connect
WaitResponse
If Not (FTPCODE = "125" Or FTPCODE = "150") Then Exit Function
FTPUpload = SPath & "\" SFile
End Function
Function Upload(FilePath)
Dim UPFile
Dim FileLen
Dim TotalSent
Dim a
Set a = WScript.CreateObject("ADODB.Stream")
a.open
a.Type = 1
a.LoadFromFile (FilePath)
UPFile = a.Read()
FTPCOMPLETE = False
W2.SendData UPFile
EsperaSubida = 0
Do
WScript.Sleep 1000
EsperaSubida = EsperaSubida + 1
If SendIsComplete = 1 Then Upload = True: Exit Function
If EsperaSubida > 300 Then Exit Function
Loop
End Function
Sub W1_DataArrival(ByVal bytesTotal)
W1.GetData FTPData, 8
End Sub
Function SendIsComplete()
SendIsComplete = FTPCOMPLETE
End Function
Sub w2_SendComplete()
FTPCOMPLETE = 1
End Sub
Function WaitResponse()
Espera = 0
Do
WScript.Sleep 1000
Espera = Espera + 1
If Espera > 10 Then WaitResponse = 1: Exit Function
If FTPCODE <> 0 Then Exit Function
Loop
End Function
Function FTPCODE()
If Len(FTPData) > 3 Then FTPCODE = Left(FTPData, 3) Else FTPCODE = 0
End Function
GRACIAS POR LEER!!!