1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

Sub Test()
  Dim Files As Collection
  Dim I     As Long
  Dim sPath As String
  sPath = Excel.ThisWorkbook.Path 'excel VBA所在資料夾路徑
  
  Set Files = FTPSearch("ftp網址", "帳號", "密碼") 'ftp網址 , 帳號 , 密碼
  
  For I = 1 To Files.Count
    Debug.Print Files.Item(I) '列出所有檔案路徑
  Next I
  
  '#1
  Debug.Print Files.Count
  URLDownloadToFile 0, "目標檔案下載路徑", sPath & "\檔案名稱.副檔名", 0, 0  '0,目標檔案下載路徑,本機儲存路徑+檔案名稱,0,0

  '#2
  Dim sFileUrl As String
  sFileUrl = StrConv("目標檔案下載路徑", vbUnicode)
  'Debug.Print sFileUrl
  DoFileDownload sFileUrl
  
End Sub

 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

Public Property Get FTPSearch(ByVal FTPUrl As String, _
        Optional ByVal UserName As String, _
        Optional ByVal PassWord As String, _
        Optional ByVal Port As Integer) As Collection
                           
  Dim objShell  As Object, objFolder As Object
  
  On Error Resume Next
  
  If Len(FTPUrl) Then
    If Len(UserName) Then FTPUrl = UserName & ":" & PassWord & "@" & FTPUrl
    If Port > 0 Then FTPUrl = FTPUrl & ":" & Port
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace("FTP://" & FTPUrl)
  End If
  Set FTPSearch = New Collection
  If objFolder Is Nothing Then Exit Function
  
  With objFolder
    If .ParentFolder.Self.IsFolder Then                           '判斷是否還有上一層
      If .ParentFolder.ParseName(.Self.Name) Is Nothing Then
        Debug.Print "Error:Invalid Path!"
      ElseIf objFolder.Self.IsBrowsable Then
        Debug.Print "Error:Invalid Parameter!"
      ElseIf objFolder.Self.IsFolder Then
        Debug.Print "Start search files in path..."
        With objFolder
          FTPSearchWithShell FTPSearch, .ParentFolder.ParseName(.Self.Name).GetFolder
        End With
        Debug.Print "Files search completed."
      End If
    ElseIf objFolder.Self.IsFolder Then
      Debug.Print "Start search files in path..."
      With objFolder
        FTPSearchWithShell FTPSearch, objFolder '將 FTPSearch-要建立的屬性 與 objFolder-ftp根目錄  傳到 FTPSearchWithShell 記錄檔案路徑
      End With
      Debug.Print "Files search completed."
    End If
  End With
End Property
'
'記錄檔案路徑
'
Private Sub FTPSearchWithShell(ByVal Searched As Collection, ByVal Folder As Object, Optional ByVal strPath As String)
  Dim FolderItem  As Object
  Dim objFolder   As Object
  Dim subSearch   As New Collection '類似 python的元組
  
  On Error Resume Next
  
  If Len(strPath) = 0 Then
    Set objFolder = Folder
    Do While (objFolder.ParentFolder.Self.IsFolder)
      strPath = objFolder.Self.Name & "/" & strPath
      Set objFolder = objFolder.ParentFolder
    Loop
    strPath = objFolder.Self.Path & strPath
  End If
  
  If Folder.Items.Count > 0 Then
    Set subSearch = New Collection
    For Each FolderItem In Folder.Items
      With FolderItem
        If .IsFolder Then
          Set Folder = .GetFolder
          If Folder.Items.Count Then subSearch.Add Folder
        ElseIf .IsBrowsable Then
          Searched.Add strPath & .Name
        End If
      End With
    Next FolderItem
   
    For Each Folder In subSearch
      FTPSearchWithShell Searched, Folder
      DoEvents
    Next Folder
  End If
End Sub

 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

Sub FTP_SHELL()
    Dim strPNAME As String                        '參數文件名
    Dim nFNO As Integer                           '文件編號
    
    strPNAME = ThisWorkbook.Path & "\ftptest.txt" '文件名生成
    nFNO = FreeFile                               '選取空的文件編號
    
    Open strPNAME For Output As #nFNO             '生成新的文件
    
    Print #nFNO, "open ftp網址"                    'open主机名
    Print #nFNO, "user 帳號 密碼"                  'user命令 用戶名 密碼
    Print #nFNO, "cd WWW"                         '切換至WWW資料夾
    Print #nFNO, "pwd"                            '顯示目前工作目錄
    Print #nFNO, "binary"                         '轉換成二進制模式
    Print #nFNO, "get 1101224.jpg " & ThisWorkbook.Path & "\1101224.jpg"
    Print #nFNO, "bye"                            '關閉 ftp
    
    Close #nFNO                                   '關閉參數文件
                                                  
    Shell "ftp -n -s:" & strPNAME                 'shell啟動 ftp 執行command line
    
    'Application.Wait (Now + TimeValue("0:00:05")) '程式暫停  避免還沒下載檔案
    
    'Dim xFile As String
    'xFile = Dir(strPNAME)
    
    'Debug.Print xFile
    
'    If xFile <> "" Then
'        Kill strPNAME
'    End If
End Sub