Русские символы в wininet (экспорт на ftp)

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Русские символы в wininet (экспорт на ftp) (Макросы/Sub)

itinich

Дата: Четверг, 26.05.2022, 14:48 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 8

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Здравствуйте, уважаемые форумчане.
Помогите пожалуйста с решением.
Использую вот такой скрипт для выгрузки файла на ftp всё работает нормально, до того момента пока в названии создаваемого на ftp каталога или файла не появляются русские символы.
Вот так работает:

[vba]

Код

'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

[/vba]

А вот так уже нет((

[vba]

Код

'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

[/vba]

Разница между кодами только в русских символах в названии каталога.
Помогите, пожалуйста, решить проблему.
FTPServer это FileZilla, если к нему цепляться "руками" любым из клиентов, каталоги с русскими символами работают норм.
Есть предположение что "собака порылась" в кодировках (ANSI / Unicode), но вот куда смотреть ума не приложу.

Во вложении файл пример. если переименовать его убрав русские символы и в макросе исправить создаваемый каталог аналогичным образом, то всё работает как нужно.

[vba]

Код

[/vba]

А вот так уже нет((

[vba]

Код

'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

[/vba]

К сообщению приложен файл: _FTP_.xlsm (21.7 Kb)

Сообщение отредактировал itinich - Четверг, 26.05.2022, 16:39

Ответить

СообщениеЗдравствуйте, уважаемые форумчане.
Помогите пожалуйста с решением.
Использую вот такой скрипт для выгрузки файла на ftp всё работает нормально, до того момента пока в названии создаваемого на ftp каталога или файла не появляются русские символы.
Вот так работает:

[vba]

Код

[/vba]

А вот так уже нет((

[vba]

Код

'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

[/vba]

Автор - itinich
Дата добавления - 26.05.2022 в 14:48

китин

Дата: Четверг, 26.05.2022, 15:15 | Сообщение № 2

Группа: Модераторы

Ранг: Экселист

Сообщений: 7015

Репутация: 1073 ±

Замечаний: 0% ±

Excel 2007;2010;2016

itinich, - Прочитайте Правила форума
- Оформите код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)
- Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 500 кб согласно п.3 Правил форума

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Ответить

itinich

Дата: Четверг, 26.05.2022, 16:40 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 8

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

прошу прощения, всё исправил.
благодарю за поправку.

кстати файл изначально назывался "_FTP тест.xlsm", во время прикрепления к сообщению название порезано.

Сообщение отредактировал itinich - Четверг, 26.05.2022, 16:42

Ответить

itinich

Дата: Четверг, 26.05.2022, 18:45 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 8

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

нашёл нечто похожее, но не понимаю как это применить((
тыц

Ответить

_Boroda_

Дата: Пятница, 27.05.2022, 09:14 | Сообщение № 5

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Посмотрите здесь
Там несколько похожих тем есть с хорошими ответами

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

itinich

Дата: Вторник, 31.05.2022, 20:14 | Сообщение № 6

Группа: Пользователи

Ранг: Прохожий

Сообщений: 8

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Решение найдено.
Доступно здесь

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Русские символы в wininet (экспорт на ftp) (Макросы/Sub)

Страница 1 из 1
1