12
返回列表 上一主題 發帖

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

warhead

帖子
33 
主題
10 
精華
0 
積分
74 
點名
0  
作業系統
win7 
軟體版本
2007 
閱讀權限
20 
性別
男 
註冊時間
2011-6-9 
最後登錄
2024-7-8 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2020-11-2 09:58 | 只看該作者

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

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

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

cody

帖子
16 
主題
2 
精華
0 
積分
55 
點名
0  
作業系統
macOS / Windows 
軟體版本
Office 2010/2019 
閱讀權限
20 
性別
男 
註冊時間
2020-7-9 
最後登錄
2021-8-7 
2#
發表於 2020-11-4 16:18 | 只看該作者
本帖最後由 cody 於 2020-11-4 16:27 編輯

回復 1# warhead


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

TOP

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-11-6 
3#
發表於 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

warhead

帖子
33 
主題
10 
精華
0 
積分
74 
點名
0  
作業系統
win7 
軟體版本
2007 
閱讀權限
20 
性別
男 
註冊時間
2011-6-9 
最後登錄
2024-7-8 
4#
發表於 2020-11-9 14:41 | 只看該作者
回復 2# cody


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

TOP

warhead

帖子
33 
主題
10 
精華
0 
積分
74 
點名
0  
作業系統
win7 
軟體版本
2007 
閱讀權限
20 
性別
男 
註冊時間
2011-6-9 
最後登錄
2024-7-8 
5#
發表於 2020-11-9 14:44 | 只看該作者
回復 3# Joforn


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

TOP

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

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

TOP

warhead

帖子
33 
主題
10 
精華
0 
積分
74 
點名
0  
作業系統
win7 
軟體版本
2007 
閱讀權限
20 
性別
男 
註冊時間
2011-6-9 
最後登錄
2024-7-8 
7#
發表於 2020-11-10 10:18 | 只看該作者
回復 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

  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

  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

  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

  83.   
複製代碼
我將檔案路徑丟給selectFolder，會出問題


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


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


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

TOP

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-11-6 
8#
發表於 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

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
9#
發表於 2020-11-11 14:17 | 只看該作者
回復 8# Joforn


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

第一個VBA執行中文檔案名稱回傳正常
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

warhead

帖子
33 
主題
10 
精華
0 
積分
74 
點名
0  
作業系統
win7 
軟體版本
2007 
閱讀權限
20 
性別
男 
註冊時間
2011-6-9 
最後登錄
2024-7-8 
10#
發表於 2020-11-11 15:33 | 只看該作者
回復 8# Joforn


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

TOP

        靜思自在 : 屋寬不如心寬。
12
返回列表 上一主題