使用VBA代码从FTP服务器下载目录

Question

我在线获取此脚本可将特定文件从FTP服务器下载到本地磁盘，但我需要帮助才能自动下载指定的目录/文件夹。

在我的情况下，FTP目录中的文件{/ database：目录名}在晚上更新我希望VBA代码自动下载目录，并在会话文件关闭后在FTP目录中提供内容。会话关闭文件是4_04122013.ets，它是0 B，其中4是特定类型文件结算的标志，然后是当前日期和扩展名。在目录中更新此会话关闭文件后，此VBA代码开始将目录从FTP服务器下载到我的本地磁盘。 [d：\ FTP]

请问，请帮帮忙？

    Option Explicit
    ' 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 GetIMG_XML()

    ' I've commented out the uninteresting MsgBox lines; they show long (and meaningless)numbers.

    Dim AgentStr As String
     Dim AccessTypeLong As Long
     Dim ProxyNameStr As String
     Dim ProxyBypassStr As String
     Dim FlagsLong As Long

    Dim InternetSessionLong As Long
     Dim ServerNameStr As String
     Dim ServerPortInt As Integer
     Dim UserNameStr As String
     Dim PasswordStr As String
     Dim ServiceLong As Long
     Dim ContextLong As Long

    Dim FTPSessionLong As Long
     Dim RemoteFileStr As String
     Dim NewFileStr As String
     Dim FailIfExistsBool As Boolean
     Dim FlagsAndAttributesLong As Long

    Dim SomeThingLong As Long
    Dim MyInternetHandleLong As Long
    Dim MyFTPHandleLong As Long
    Dim SomeInteger As Integer
    Dim FTPSuccessBool As Boolean ' Did the FTP download work?

    ' ** Call INTERNET OPEN first **

    AgentStr = "FTP Download" ' can be whatever
    AccessTypeLong = 0 ' zero appears to work fine
    ProxyNameStr = "" ' nul works fine here
    ProxyBypassStr = "" ' nul works fine here
    FlagsLong = 0 ' zero appears to work fine

    MyInternetHandleLong = InternetOpen(AgentStr, AccessTypeLong, ProxyNameStr,
    ProxyBypassStr,FlagsLong)

    ' MsgBox MyInternetHandleLong

    ' ** Call Internet CONNECT next **

    ' The directory I want to get is at ftp://xxx.xxx.xxx.xxx in directory /database
    'having .img '& .xml files 

    with current date.

    'MyInternetHandleLong is obtained above
     ServerNameStr = "xxx.xxx.xxx.xxx" ' address of the FTP server, WITHOUT the "ftp://" part
     ServerPortInt = 21 ' default FTP port
     UserNameStr = "zmagic"
     PasswordStr = "password8" ' nul is the default
     ServiceLong = 1 ' this for the FTP service (2 = gopher, 3 = http)
     FlagsLong = 0 ' 0 appears to work fine here
     ContextLong = 0 ' 0 appears to work fine here

    MyFTPHandleLong = InternetConnect(MyInternetHandleLong, ServerNameStr, ServerPortInt, 
    UserNameStr, PasswordStr, ServiceLong, FlagsLong, ContextLong)

    ' MsgBox "My FTP handle = " & MyFTPHandleLong
     ' (this is NOT the same value as MyInternetHandle, above)

    ' ** Call FTP Get File next **

    ' MyFTPHandleLong is obtained above

    RemoteFileStr = "/database/*"  'directory
     NewFileStr = "D:\FTP\" ' file name on MY system
     FailIfExistsBool = False ' should NOT fail if file already exists on MY computer....HOWEVER,
     ' if the file does exist, the FTP DOES fail. Don't know about this. Short answer:
     ' the target file should NOT exist on my computer before calling this routine!
     FlagsAndAttributesLong = 128 ' Normal file, no special flags set.
     FlagsLong = 2 ' FTP Transfer Type Binary (the default)
     ContextLong = 0 ' apparently not required.

    FTPSuccessBool = FtpGetFile(MyFTPHandleLong, RemoteFileStr, NewFileStr, FailIfExistsBool, 
    FlagsAndAttributesLong, FlagsLong, ContextLong)

    MsgBox "FTP Success = " & FTPSuccessBool

    ' ** Finally, close the connection **

    SomeInteger = InternetCloseHandle(MyInternetHandleLong)

    ' MsgBox SomeInteger
     ' Seems to return "1"
     End Sub