返回列表 上一主題 發帖

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

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-11-6 
1# 跳轉到 »
發表於 2020-11-5 23:32 | 顯示全部帖子
本帖最後由 Joforn 於 2020-11-5 23:33 編輯
  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

  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
複製代碼
世界那麼大，可我想去哪？

TOP

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-11-6 
2#
發表於 2020-11-9 19:50 | 顯示全部帖子
回復 5# warhead
遞歸查找和對比所有文件。
世界那麼大，可我想去哪？

TOP

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-11-6 
3#
發表於 2020-11-11 00:25 | 顯示全部帖子
回復 7# warhead
用的是Shell32就不要去混用FSO了，直接用Shell32查找吧。
  1. Option Explicit

  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

  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

  55. Sub Test()
  56.   Dim Files As Collection
  57.   Dim I     As Long

  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
複製代碼
世界那麼大，可我想去哪？

TOP

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-11-6 
4#
發表於 2020-11-12 00:07 | 顯示全部帖子
回復  Joforn


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

第一個VBA執行 ...
ML089 發表於 2020-11-11 14:17


.Path返回的并不是亂碼，而是將文字進行了Url編碼，可以通過Url解碼得到原字符串，也可以用下面的方式直接返回文字格式。
  1. Public Property Get FTPSearch(ByVal FTPUrl As String, _
  2.         Optional ByVal UserName As String, _
  3.         Optional ByVal PassWord As String, _
  4.         Optional ByVal Port As Integer) As Collection
  5.                            
  6.   Dim objShell  As Object, objFolder As Object
  7.   
  8.   On Error Resume Next
  9.   
  10.   If Len(FTPUrl) Then
  11.     If Len(UserName) Then FTPUrl = UserName & ":" & PassWord & "@" & FTPUrl
  12.     If Port > 0 Then FTPUrl = FTPUrl & ":" & Port
  13.     Set objShell = CreateObject("Shell.Application")
  14.     Set objFolder = objShell.Namespace("FTP://" & FTPUrl)
  15.   End If
  16.   Set FTPSearch = New Collection
  17.   If objFolder Is Nothing Then Exit Function
  18.   
  19.   With objFolder
  20.     If .ParentFolder.Self.IsFolder Then
  21.       If .ParentFolder.ParseName(.Self.Name) Is Nothing Then
  22.         Debug.Print "Error:Invalid Path!"
  23.       ElseIf objFolder.Self.IsBrowsable Then
  24.         Debug.Print "Error:Invalid Parameter!"
  25.       ElseIf objFolder.Self.IsFolder Then
  26.         Debug.Print "Start search files in path..."
  27.         With objFolder
  28.           FTPSearchWithShell FTPSearch, .ParentFolder.ParseName(.Self.Name).GetFolder
  29.         End With
  30.         Debug.Print "Files search completed."
  31.       End If
  32.     ElseIf objFolder.Self.IsFolder Then
  33.       Debug.Print "Start search files in path..."
  34.       With objFolder
  35.         FTPSearchWithShell FTPSearch, objFolder
  36.       End With
  37.       Debug.Print "Files search completed."
  38.     End If
  39.   End With
  40. End Property

  42. Private Sub FTPSearchWithShell(ByVal Searched As Collection, ByVal Folder As Object, Optional ByVal strPath As String)
  43.   Dim FolderItem  As Object
  44.   Dim objFolder   As Object
  45.   Dim subSearch   As New Collection
  46.   
  47.   On Error Resume Next
  48.   
  49.   If Len(strPath) = 0 Then
  50.     Set objFolder = Folder
  51.     Do While (objFolder.ParentFolder.Self.IsFolder)
  52.       strPath = objFolder.Self.Name & "/" & strPath
  53.       Set objFolder = objFolder.ParentFolder
  54.     Loop
  55.     strPath = objFolder.Self.Path & strPath
  56.   End If
  57.   
  58.   If Folder.Items.Count > 0 Then
  59.     Set subSearch = New Collection
  60.     For Each FolderItem In Folder.Items
  61.       With FolderItem
  62.         If .IsFolder Then
  63.           Set Folder = .GetFolder
  64.           If Folder.Items.Count Then subSearch.Add Folder
  65.         ElseIf .IsBrowsable Then
  66.           Searched.Add strPath & .Name
  67.         End If
  68.       End With
  69.     Next FolderItem
  70.    
  71.     For Each Folder In subSearch
  72.       FTPSearchWithShell Searched, Folder
  73.       DoEvents
  74.     Next Folder
  75.   End If
  76. End Sub

  78. Sub Test()
  79.   Dim Files As Collection
  80.   Dim I     As Long
  81.   
  82.   Set Files = FTPSearch("118.163.50.55/firmware_software_version_files/", "xxxxx", "xxxx")
  83.   For I = 1 To Files.Count
  84.     Debug.Print Files.Item(I)
  85.   Next I
  86. End Sub
複製代碼
世界那麼大，可我想去哪？

TOP

        靜思自在 : 成功是優點的發揮，失敗是缺點的累積。
返回列表 上一主題