[發問] vba 讀取 ftp 裡面的檔案清單

warhead

我需要常常到公司的ftp抓取資料回來處理，
所以想要利用vba去看看有哪些檔案是更新過的，
在抓回來處理，就不用每一個資料夾都進去看。

但ftp有帳號密碼，無法使用一般dir的方式去尋找，
網路上找不到相關的資料(也可能是我找錯方向)，
是否有前輩可以提點一下我該如何做到，或是從哪個方向下手呢?

cody

回復 1# warhead


用 windows 內建 ftp.exe 讀取 Script 的方式
一般是將 ftp comment 做成文字檔, 再用 ftp.exe 去讀取執行
將結果存成文字檔後, 再讀入excel

Joforn

1. Private Function FTPFolder(ByVal Url As String, _
   
2.     Optional ByVal UserName As String, _
   
3.     Optional ByVal PassWord As String, _
   
4.     Optional ByVal Port As Integer) As Object
   
5.   Dim objShell  As Object
   
6.   
   
7.   If Len(Url) Then
   
8.     If Len(UserName) Then Url = UserName & ":" & PassWord & "@" & Url
   
9.     If Port > 0 Then Url = Url & ":" & Port
   
10.     Set objShell = CreateObject("Shell.Application")
    
11.     Set FTPFolder = objShell.Namespace("FTP://" & Url)
    
12.   End If
    
13. End Function
    
14. 
    
15. Sub Test()
    
16.   Dim objFolder As Object
    
17.   Dim objItem   As Object
    
18.   
    
19.   Set objFolder = FTPFolder("0.0.0.0", "username", "password")
    
20.   If Not (objFolder Is Nothing) Then
    
21.     For Each objItem In objFolder.Items
    
22.       Debug.Print "Name=""" & objItem.Name & """ Size=" & objFolder.GetDetailsOf(objItem, 1) & " ModifyDate=" & objFolder.GetDetailsOf(objItem, 3)
    
23.     Next
    
24.   End If
    
25. End Sub

複製代碼

warhead

回復 2# cody


    好的，我在找時間研究看看ftp的comment，謝謝

warhead

回復 3# Joforn


    這方法可行，感激不盡....
   
    另外在提問一個問題，如果裡面還有資料夾，我是將全部資料夾抓出來，
    在一個一個資料夾進去檢查是否有新的檔案嗎?
    或是有其他方式可行?

Joforn

回復 5# warhead
遞歸查找和對比所有文件。

warhead

回復 6# Joforn

1.     Private Function FTPFolder(ByVal Url As String, _
   
2.     Optional ByVal UserName As String, _
   
3.     Optional ByVal PassWord As String, _
   
4.     Optional ByVal Port As Integer) As Object
   
5.   Dim objShell  As Object
   
6.   
   
7.   If Len(Url) Then
   
8.     If Len(UserName) Then Url = UserName & ":" & PassWord & "@" & Url
   
9.     If Port > 0 Then Url = Url & ":" & Port
   
10.     Set objShell = CreateObject("Shell.Application")
    
11.     Set FTPFolder = objShell.Namespace("FTP://" & Url)
    
12.   End If
    
13. End Function
    
14. 
    
15. Sub test()
    
16.   Dim objFolder As Object
    
17.   Dim objItem   As Object
    
18.   Dim selectFolder
    
19.   
    
20.   Set objFolder = FTPFolder("118.163.50.55/firmware_software_version_files/", "xxxxx", "xxxx")
    
21.   
    
22.   If Not (objFolder Is Nothing) Then
    
23.    
    
24.     selectFolder = objFolder
    
25.    
    
26.     Call 列出檔案清單(selectFolder)
    
27. End If
    
28. End Sub
    
29. 
    
30. Sub 列出檔案清單(ByVal theDir As String)
    
31.     Dim pt As Range
    
32.                
    
33.     Set pt = Sheet1.Range("a2")
    
34.     Call 設定標題(1)
    
35.                
    
36.     If Len(Dir(theDir, vbDirectory)) > 0 Then
    
37.         If (GetAttr(theDir) And vbDirectory) = vbDirectory Then
    
38.             Call FileIOUtility.RetrivalFileList(theDir, pt, 0)
    
39.         End If
    
40.     End If
    
41.    
    
42.     pt.Worksheet.Columns("A:B").AutoFit
    
43. End Su
    
44. 
    
45. Function RetrivalFileList(ByVal strDir As String, ByRef myRange As Range, ByRef depth As Integer)
    
46.     Dim thePath As String
    
47.     Dim strSdir As String
    
48.     Dim theDirs As Scripting.Folders
    
49.     Dim theDir As Scripting.Folder
    
50.     Dim theFile As Scripting.File
    
51.     Dim myFso As Scripting.FileSystemObject
    
52.     Dim subFolderCount As Integer
    
53.    
    
54.     Set myFso = New Scripting.FileSystemObject
    
55.     If Right(strDir, 1) <> "" Then strDir = strDir & ""
    
56.     thePath = thePath & strDir
    
57.         
    
58.     '列出第一層根目錄的檔案
    
59.     If depth = 0 Then
    
60.             For Each theFile In myFso.GetFolder(strDir).Files
    
61.                 myRange = theFile.Path
    
62.                 myRange.Next = theFile.Size
    
63.                 myRange.Next.Next = theFile.DateLastModified
    
64.                 Set myRange = myRange.Offset(1, 0)
    
65.             Next
    
66.             depth = 1
    
67.     End If
    
68.         
    
69.     '尋找所有子目錄的檔案
    
70.     Set theDirs = myFso.GetFolder(strDir).SubFolders
    
71.     For Each theDir In theDirs
    
72.         For Each theFile In theDir.Files
    
73.             myRange = theFile.Path
    
74.             myRange.Next = theFile.Size
    
75.             myRange.Next.Next = theFile.DateLastModified
    
76.             Set myRange = myRange.Offset(1, 0)
    
77.         Next
    
78.         RetrivalFileList strDir:=theDir.Path, myRange:=myRange, depth:=depth
    
79.     Next
    
80.     Set myFso = Nothing
    
81. End Function
    
82. 
    
83.   

複製代碼

我將檔案路徑丟給selectFolder，會出問題


但如果我給selectFolder 的路徑是電腦本機的卻可以執行，


給selectFolder 完整的FTP路徑也會出錯，


是因為FTP查詢的方式跟本機的不一樣嗎??

Joforn

回復 7# warhead
用的是Shell32就不要去混用FSO了，直接用Shell32查找吧。

1. Option Explicit
   
2. 
   
3. Public Property Get FTPSearch(ByVal FTPUrl As String, _
   
4.         Optional ByVal UserName As String, _
   
5.         Optional ByVal PassWord As String, _
   
6.         Optional ByVal Port As Integer) As Collection
   
7.                            
   
8.   Dim objShell  As Object, objFolder As Object
   
9.   
   
10.   On Error Resume Next
    
11.   
    
12.   If Len(FTPUrl) Then
    
13.     If Len(UserName) Then FTPUrl = UserName & ":" & PassWord & "@" & FTPUrl
    
14.     If Port > 0 Then FTPUrl = FTPUrl & ":" & Port
    
15.     Set objShell = CreateObject("Shell.Application")
    
16.     Set objFolder = objShell.Namespace("FTP://" & FTPUrl)
    
17.   End If
    
18.   FTPSearchWithShell FTPSearch, objFolder
    
19. End Property
    
20. 
    
21. Private Sub FTPSearchWithShell(ByRef Searched As Collection, ByVal Folder As Object)
    
22.   Dim FolderItem  As FolderItem
    
23.   Dim subSearch   As New Collection
    
24.   
    
25.   On Error GoTo ErrorLOOP
    
26.   
    
27.   If Searched Is Nothing Then Set Searched = New Collection
    
28.   
    
29.   If Folder.Items.Count > 0 Then
    
30.     Set subSearch = New Collection
    
31.     For Each FolderItem In Folder.Items
    
32.       With FolderItem
    
33.         If .IsFolder Then
    
34.           Set Folder = .GetFolder
    
35.           If Folder.Items.Count Then subSearch.Add Folder
    
36.         ElseIf .IsBrowsable Then
    
37.           Searched.Add .Path
    
38.         End If
    
39.       End With
    
40.     Next FolderItem
    
41.    
    
42.     For Each Folder In subSearch
    
43.       FTPSearchWithShell Searched, Folder
    
44.       DoEvents
    
45.     Next Folder
    
46.   End If
    
47. EXITFunction:
    
48.   On Error Resume Next
    
49.   Exit Sub
    
50. ErrorLOOP:
    
51.   Err.Clear
    
52.   Resume EXITFunction
    
53. End Sub
    
54. 
    
55. Sub Test()
    
56.   Dim Files As Collection
    
57.   Dim I     As Long
    
58. 
    
59.   Set Files = FTPSearch("118.163.50.55/firmware_software_version_files/", "xxxxx", "xxxx")
    
60.   For I = 1 To Files.Count
    
61.     Debug.Print Files.Item(I)
    
62.   Next I
    
63. End Sub

複製代碼

ML089

回復 8# Joforn


這VBA執行OK，可是中文檔案名稱回傳變成亂碼，請問這要如何修正，感恩

第一個VBA執行中文檔案名稱回傳正常

warhead

回復 8# Joforn


    程式可執行，但超出我功力太多，需要時間慢慢消化，謝謝。