|
|
|
Supreme Being
участник
Last Login: 16.04.2008 11:44
Сообщ.: 366,
Visits: 2 473
|
|
прочел статью В.Сизова "Как применять FTP в документах Microsoft Office"
По мотивам написал такую процедуру.
Public Const lcl_path As String = "c:\hr\"
Public Const ftp_path As String = "in\"
Public my_names(1 To 5) As String
Sub clear_old_load_new()
Dim my_names, file_array As Variant
my_names = Array("com", "edu", "emp", "fam", "wor")
Set fs = CreateObject("Scripting.FileSystemObject")
'очищаем старые файлы из локальной директории
If Not fs.FolderExists(lcl_path) Then
fs.CreateFolder (lcl_path)
Else
If fs.FileExists(lcl_path & my_names(0) & ".csv") Then
Kill lcl_path & "\*.csv" '?
End If
End If
'загружаем новые с ftp
With FormFTP.Inet1
.RemoteHost = "192.168.1.113"
.RemotePort = 21
.UserName = "test"
.Password = "test"
.URL = "ftp://test:test@192.168.1.113"
For Each nam In my_names
If .StillExecuting Then
Application.Wait (Now + TimeValue("0:00:02"))
End If
.Execute , "GET " & ftp_path & nam & ".csv " & lcl_path & nam & ".csv"
Next
Application.Wait (Now + TimeValue("0:00:01"))
.Execute , "CLOSE"
.Execute , "QUIT"
End With
Module1.Anketa
End Sub
Однако не совсем понял использование события Inet1_StateChanged. В отладчике (построчное исполнение F8) все проходит гладко, но как только процедура запускается полностью (F5) в непредсказуемом порядке появляются 2 типа ошибок:
1 code has been interrupted, как будто я сам прервал исполнение.
2 run-time error 35764 still executing last request
Если продолжить выполнение процедуры после генерации ошибки, то само копирование с ftp проходит. Приложение работает не стабильно. Очевидно, что в момент повторного вызова инструкции GET предыдущая еще не отработала. Проверка свойства
If .StillExecuting Then Application.Wait (Now + TimeValue("0:00:02")) не верна по смыслу и не эффективна (то работает то нет).
Нужно отслеживать состояние объекта Inet1, используя событие StateChanged. Все самостоятельные попытки сделать это, пока ни к чему не привели.
Использую: win xp sp2, ms office 2003
С уважением,
|
|
|
|
|
Supreme Being
участник
Last Login: 16.04.2008 11:44
Сообщ.: 366,
Visits: 2 473
|
|
Добиться стабильной работы msinet.ocx так и не смог. Пробовал с помощью ftp.exe и через API. Последний вариант оказался наиболее простым и предсказуемым в работе.
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
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
Private Declare Function InternetOpen _
Lib "wininet.dll" Alias "InternetOpenA" ( _
ByVal sAgent As String, _
ByVal nAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal nFlags As Long) As Long
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 nService As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle _
Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Const INTERNET_SERVICE_FTP = 1
Sub engine()
rez = ftp_upload("get")
Module1.Anketa
rez = ftp_upload("put")
End Sub
Function ftp_upload(we_make As String) As Boolean
my_names = Array("com", "edu", "emp", "fam", "wor")
If we_make = "get" Then
For Each nam In my_names
hINetSession = InternetOpen("MyFTPClient", 1, vbNullString, vbNullString, 0)
hSession = InternetConnect(hINetSession, "172.31.27.120", _
"21", "user_hr", "passhr", INTERNET_SERVICE_FTP, 0, 0)
If FtpGetFile(hSession, "/export/home/user_hr/HR/" & nam & ".csv", "c:\HR\" & nam & ".csv", False, 0, 2, 0) = False Then
msgbox "Call to FtpGetFile Failed!"
End If
Call InternetCloseHandle(hSession)
Call InternetCloseHandle(hINetSession)
Next
End If
If we_make = "put" Then
For Each nam In my_names
hINetSession = InternetOpen("MyFTPClient", 1, vbNullString, vbNullString, 0)
hSession = InternetConnect(hINetSession, "172.31.27.120", _
"21", "user_hr", "passhr", INTERNET_SERVICE_FTP, 0, 0)
If FtpPutFile(hSession, "c:\HR\" & nam & ".csv", "/export/home/user_hr/HR/" & nam & ".csv", 1, 0) = False Then
msgbox "The call to FtpPutFile failed."
End If
Call InternetCloseHandle(hSession)
Call InternetCloseHandle(hINetSession)
Next
End If
End Function
Вопрос закрыт!
С уважением,
|
|
|
|