Перепробовал всевозможные коды, которые нашел в интернете по поводу загрузки файла на фтп...ничего не помогло...Можете подкинуть какой нибудь код для этой задачи...?
Сервер: ftp://xserv20588.hybridserver.at/BA Пользователь: sw5xxsbk Пароль: 123456 Файл, который нужно загрузить: C:\Users\Alexandr Shlika\Desktop\BA_Hurtel.csv
я выбрал Put для загрузки на сервер, логин, пароль, не совсем уверен, правильно ли я вписал сам фтп и где указывать локальное место нахождение файла, который я хочу загрузить на сервер?
Код
Sub Put_File_To_FTP()
'Variable Declarion Section
Dim FTP As Inet
'Assign Host URL, Source and Destination File path
HostURL = ThisWorkbook.Sheets(1).Cells(1, 1)
FileSource = ThisWorkbook.Sheets(1).Cells(1, 2)
FileDestination = ThisWorkbook.Sheets(1).Cells(2, 2)
'Create New instance of Object and Assign the Parameters
Set FTP = New Inet
With FTP
.URL = HostURL
.Protocol = icFTP
'Replace with your Login and Password Below. Many FTP servers allow Anonymous access with below credentials
.UserName = "sw5xxsbk"
.Password = "DGAlksyhdf_1ldfgh"
.AccessType = icUseDefault
'Use "Get" to Download and "Put" Option to Upload File to FTP Server
.Execute .URL, "Put " & FileSource & "ftp://xserv20588.hybridserver.at/BA" & 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
источник Понравился тем, что нет ни подключения OCX ни ….
Скрытый текст
Код
'Open the Internet object
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 = ThisWorkbook.Sheets(1).Cells(1, 1)
UserName = "UserName"
Password = "Password"
localFile = ThisWorkbook.Sheets(1).Cells(1, 2) ' "C:\TEMP\File.ext"
hostFile = ThisWorkbook.Sheets(1).Cells(2, 2) ' "//Folder/Folder/File.ext"
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
написал: источник Понравился тем, что нет ни подключения OCX ни ….
Скрытый текст
Код
[URL=#]?[/URL] 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 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 'Open the Internet object 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 = ThisWorkbook.Sheets(1).Cells(1, 1) UserName = "UserName" Password = "Password" localFile = ThisWorkbook.Sheets(1).Cells(1, 2) ' "C:\TEMP\File.ext" hostFile = ThisWorkbook.Sheets(1).Cells(2, 2) ' "//Folder/Folder/File.ext" 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
'Open the Internet object
Private Declare PtrSafe 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 PtrSafe 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 PtrSafe 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 PtrSafe 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
'Create directory using FTP
Private Declare PtrSafe Function FtpCreateDirectory _
Lib "wininet.dll" _
Alias "FtpCreateDirectoryA" _
(ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
'Close the Internet object
Private Declare PtrSafe 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 SuccessDir As Long
Dim SuccessFile As Long
Dim UserName As String
On Error Resume Next
ThisWorkbook.Save
CreateObject("Scripting.FileSystemObject").DeleteFolder (ThisWorkbook.Path & "\_2ftp_")
CreateObject("Scripting.FileSystemObject").CreateFolder (ThisWorkbook.Path & "\_2ftp_")
ThisWorkbook.SaveCopyAs (ThisWorkbook.Path & "\_2ftp_\" & ThisWorkbook.Name)
ServerName = "127.0.0.1"
UserName = "test"
Password = "test"
localFile = ThisWorkbook.Path & "\_2ftp_\" & ThisWorkbook.Name
hostFile = "//TestFolder/" & ThisWorkbook.Name
RetVal = False
INet = InternetOpen("---", 0, "", "", 0)
If INet > 0 Then
INetConn = InternetConnect(INet, ServerName, 0, UserName, Password, 1, 0, 0)
If INetConn > 0 Then
SuccessDir = FtpCreateDirectory(INetConn, "TestFolder")
SuccessFile = FtpPutFile(INetConn, localFile, hostFile, 0, 0)
RetVal = InternetCloseHandle(INetConn)
End If
RetVal = InternetCloseHandle(INet)
End If
CreateObject("Scripting.FileSystemObject").DeleteFolder (ThisWorkbook.Path & "\_2ftp_")
End Sub
А вот так нет:
Скрытый текст
Код
'Open the Internet object
Private Declare PtrSafe 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 PtrSafe 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 PtrSafe 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 PtrSafe 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
'Create directory using FTP
Private Declare PtrSafe Function FtpCreateDirectory _
Lib "wininet.dll" _
Alias "FtpCreateDirectoryA" _
(ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
'Close the Internet object
Private Declare PtrSafe 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 SuccessDir As Long
Dim SuccessFile As Long
Dim UserName As String
On Error Resume Next
ThisWorkbook.Save
CreateObject("Scripting.FileSystemObject").DeleteFolder (ThisWorkbook.Path & "\_2ftp_")
CreateObject("Scripting.FileSystemObject").CreateFolder (ThisWorkbook.Path & "\_2ftp_")
ThisWorkbook.SaveCopyAs (ThisWorkbook.Path & "\_2ftp_\" & ThisWorkbook.Name)
ServerName = "127.0.0.1"
UserName = "test"
Password = "test"
localFile = ThisWorkbook.Path & "\_2ftp_\" & ThisWorkbook.Name
hostFile = "//ТестовыйКаталог/" & ThisWorkbook.Name
RetVal = False
INet = InternetOpen("---", 0, "", "", 0)
If INet > 0 Then
INetConn = InternetConnect(INet, ServerName, 0, UserName, Password, 1, 0, 0)
If INetConn > 0 Then
SuccessDir = FtpCreateDirectory(INetConn, "ТестовыйКаталог")
SuccessFile = FtpPutFile(INetConn, localFile, hostFile, 0, 0)
RetVal = InternetCloseHandle(INetConn)
End If
RetVal = InternetCloseHandle(INet)
End If
CreateObject("Scripting.FileSystemObject").DeleteFolder (ThisWorkbook.Path & "\_2ftp_")
End Sub
Во втором случае имя создаваемого каталога написано на русском.
Есть предположение что "собака порылась" в кодировках (ANSI / Unicode), но вот куда смотреть ума не приложу, помогите пожалуйста.
FTPServer это FileZilla, если к нему цепляться "руками" любым из клиентов, каталоги с русскими символами работают норм.
Такая же проблема если файл имеет русские символы в имени.
itinich написал: Есть предположение что "собака порылась" в кодировках (ANSI / Unicode), но вот куда смотреть ума не приложу, помогите пожалуйста.
Почитайте эту тему (пункт 1 про Windows API) и разъяснения Владимира (ZVI) здесь.
Суть - нужно заменить описания Windows API ANSI версий (имена заканчиваются на "A") на Unicode версии (имена заканчиваются на "W") по определенным правилам. При передаче текстов как фактических параметров вместо переменной txt нужно указать StrPtr(txt)
'Open the Internet object
Private Declare PtrSafe 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 PtrSafe 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 PtrSafe 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 PtrSafe Function FtpPutFile _
Lib "wininet.dll" _
Alias "FtpPutFileW" _
(ByVal hFtpSession As Long, _
ByVal lpszLocalFile As LongPtr, _
ByVal lpszRemoteFile As LongPtr, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
'Create directory using FTP
Private Declare PtrSafe Function FtpCreateDirectory _
Lib "wininet.dll" _
Alias "FtpCreateDirectoryW" _
(ByVal hFtpSession As Long, _
ByVal lpszDirectory As LongPtr) As Boolean
'Close the Internet object
Private Declare PtrSafe Function InternetCloseHandle _
Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Sub UploadFTP()
Dim ServerName As String
Dim UserName As String
Dim Password As String
Dim hostFile As String
Dim INet As Long
Dim INetConn As Long
Dim SuccessDir As Long
Dim SuccessFile As Long
Dim RetVal As Long
On Error Resume Next
ThisWorkbook.Save
CreateObject("Scripting.FileSystemObject").DeleteFolder (ThisWorkbook.Path & "\_2ftp_")
CreateObject("Scripting.FileSystemObject").CreateFolder (ThisWorkbook.Path & "\_2ftp_")
ThisWorkbook.SaveCopyAs (ThisWorkbook.Path & "\_2ftp_\" & ThisWorkbook.Name)
ServerName = "127.0.0.1"
UserName = "test"
Password = "test"
localFile = ThisWorkbook.Path & "\_2ftp_\" & ThisWorkbook.Name
hostFile = "//Тест/" & ThisWorkbook.Name
RetVal = False
INet = InternetOpen("---", 0, "", "", 0)
If INet > 0 Then
INetConn = InternetConnect(INet, ServerName, 0, UserName, Password, 1, 0, 0)
If INetConn > 0 Then
SuccessDir = FtpCreateDirectory(INetConn, StrPtr("Тест"))
SuccessFile = FtpPutFile(INetConn, StrPtr(localFile), StrPtr(hostFile), 0, 0)
RetVal = InternetCloseHandle(INetConn)
End If
RetVal = InternetCloseHandle(INet)
End If
CreateObject("Scripting.FileSystemObject").DeleteFolder (ThisWorkbook.Path & "\_2ftp_")
End Sub
причём судя по всему строка с именем передаваемого файла/создаваемого каталога в переменной формируется нормально (как собственно и без использования 'W', LongPtr и StrPtr). подозреваю ломается что-то дальше, на стадии передачи команды на FTPServer. включил ftp на роутере, такая же история (чтобы исключить возможные глюки FileZilla). понять бы что здесь говорят и как это применить...
а вот так реагирует уже другой FTPServer на попытку отработки скрипта с русскими символами: [I] May 28 16:45:53 pure-ftpd: (?@192.168.169.180) [INFO] test is now logged in [E] May 28 16:45:53 pure-ftpd: (test@192.168.169.180) [ERROR] Can't create directory: illegal byte sequence. [E] May 28 16:45:53 pure-ftpd: (test@192.168.169.180) [ERROR] Can't open that file: illegal byte sequence. [I] May 28 16:45:53 pure-ftpd: (test@192.168.169.180) [INFO] Logout.
itinich написал: понять бы что здесь говорят и как это применить...
Говорят о том, что упомянутые выше Windows API не поддерживают кодировку utf-8, которая сейчас используется на подавляющем большинстве серверов.
Посмотрите на возможность использования утилиты ftp (входит в состав Windows). Ей можно передать в параметрах файл в кодировке utf-8, содержащий нужные команды. Утилиту можно вызвать из Excel.
Альтернатива - curl (входит в текущую версию Windows и может устанавливаться на предыдущие версии). Эта программа всё умеет делать.
В общем уважаемые форумчане в итоге как обычно всё через известное место))) Макрос делает следующее: - создаёт в %AppData% скрытый каталог - создаёт там батник и скрипт работы стандартной команды windows ftp - запускает батник - удаляет за собой скрытый каталог с содержимым Зато работает с русскими символами и пробелами в именах))) А ещё возможно и не требует адаптации к различным версиям ОС и офис И ещё обнаруженный нюанс - FileZilla Server не поддерживает команду mput *.* (ну это так на будущее, мало ли кому-то пригодится)
Скрытый текст
Код
Sub Upload2FTP()
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.DeleteFolder (Environ("APPDATA") & "\2ftp")
FSO.CreateFolder (Environ("APPDATA") & "\2ftp")
FSO.GetFolder(Environ("APPDATA") & "\2ftp").Attributes = 2
ThisWorkbook.Save
On Error GoTo 0
Dim put2ftp As Object
Dim putscript As Object
Set put2ftp = FSO.CreateTextFile(Environ("APPDATA") & "\2ftp" & "\put2ftp.bat", True, False)
put2ftp.WriteLine "cd " & Environ("APPDATA") & "\2ftp"
put2ftp.WriteLine "ftp -s:putscript.txt"
put2ftp.WriteLine "cd.."
put2ftp.WriteLine "rd /s /q " & Environ("APPDATA") & "\2ftp"
Set put2ftp = Nothing
Set putscript = FSO.CreateTextFile(Environ("APPDATA") & "\2ftp" & "\putscript.txt", True, False)
putscript.WriteLine "prompt"
putscript.WriteLine "open 192.168.169.1"
putscript.WriteLine "test"
putscript.WriteLine "test"
putscript.WriteLine "MkDir Загрузка"
putscript.WriteLine "cd Загрузка"
putscript.WriteLine "binary"
putscript.WriteLine "put " & """" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & """"
putscript.WriteLine "Quit"
Set putscript = Nothing
CreateObject("WScript.Shell").Run Environ("APPDATA") & "\2ftp" & "\put2ftp.bat"
End Sub
itinich написал: понять бы что здесь говорят и как это применить...
Говорят о том, что упомянутые выше Windows API не поддерживают кодировку utf-8, которая сейчас используется на подавляющем большинстве серверов.
Посмотрите на возможность использования утилиты ftp (входит в состав Windows). Ей можно передать в параметрах файл в кодировке utf-8, содержащий нужные команды. Утилиту можно вызвать из Excel.
Альтернатива - curl (входит в текущую версию Windows и может устанавливаться на предыдущие версии). Эта программа всё умеет делать.Ка
Вы прям меня прочитали удалённо)))) Значит точно верное решение раз двум людям не сговариваясь пришло в голову)
А всё же интересно как заставить wininet работать с русскими символами. Повторюсь вот статья как это сделать на С++, но как сюда применить ума не приложу(((
кстати sokol92 примного Вам благодарен за включение головы, aka помощь, в вопросе!