雖然使用 DIR /s/o >> FileName.txt 的指令可以直接存成檔案,但輸出格式無法很方便使用,
所以昨天花了點時間,用 VB6 寫了個程式,可以列出指定目錄下的所有檔案為我自己要的格式。
主要是呼叫 Windows API 並用遞回的寫法,把檔名全都列出來
Call API 的寫法如下
'=================================
'=== Call API 的設定
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'=================================
Function OpenFolderPath() As String
'=======================================
'用 VB 呼叫出在【尋找：所有檔案】中的【瀏覽資料夾】問話框
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = "請選擇要開始搜尋的資料夾...." '<-- 此標題可根據需要自行更改
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
OpenFolderPath = sBuffer '傳回路徑字串
End If
End Function
遞回的寫法如下: ''=== 取該目錄下所有檔名
Private Function GetFileName(ByVal strFilePath As String, ByVal strInsertString As String) As String
Dim retString As String
Dim F1, fc
Dim objF As Object '定義開檔物件
Dim objFs2 As Scripting.FileSystemObject
strInsertString = gstrFileInsertString & strInsertString
Set objFs2 = CreateObject("Scripting.FileSystemObject")
Set objF = objFs2.GetFolder(strFilePath)
Set fc = objF.Files
'抓取要讀入的檔名資料
For Each F1 In fc
retString = retString & strInsertString & F1.Name & vbCrLf
Next
Set objFs2 = Nothing '釋放FileSystemObject 物件
Set objF = Nothing
GetFileName = retString
End Function
''=== 用遞回方式取出子目錄下所有檔名
Private Function GetSubFolder(ByVal strFolderPath As String, ByVal strFolderInsertString As String, ByVal strFileInsertString As String) As String
'==================================按下儲存資料夾名稱時
Dim F1, fc
Dim objF As Object '定義開檔物件
Dim strFoldersName As String '定義資料夾名稱為字串型態
Dim objFs2 As Scripting.FileSystemObject
Dim strInsertString As String
Dim strLogString As String
strFolderInsertString = gstrFolderInsertString & strFolderInsertString
strInsertString = gstrFileInsertString & strFileInsertString
Set objFs2 = CreateObject("Scripting.FileSystemObject")
Set objF = objFs2.GetFolder(strFolderPath)
Set fc = objF.SubFolders
'抓取要讀入的資料夾名稱資料
For Each F1 In fc
strLogString = strLogString & vbCrLf & strFolderInsertString & "[" & F1.Name & "]" & vbCrLf
strLogString = strLogString & GetFileName(strFolderPath & "\" & F1.Name, strInsertString)
strLogString = strLogString & GetSubFolder(strFolderPath & "\" & F1.Name, strFolderInsertString, strInsertString)
DoEvents
Next
Set objF = Nothing
Set objFs2 = Nothing '釋放FileSystemObject 物件
GetSubFolder = strLogString
End Function
由於這個程式只是臨時要用花個半天時間寫的,很多細節沒有去 Handle,能用就好,
有需要的人自行下載程式碼回去修改。
執行檔下載(7.9K)
原始程式碼下載(3.3K)
程式畫面如下
