目录列表。
有人能告诉我如何获得目录中所有文件的列表以及其中包含的任何子目录吗？我可以得到根目录中的文件列表，但进入任何子目录都有问题**** Hidden Message ***** 看看VBA文档中的FileSystemObject。它有你需要的一切。或者，您可以使用FindFirstFile和FindNextFile Win32 API函数。 James Crowley的API代码将API内容添加到顶部的模块中，并通过向表单添加cmdOBrowse_Click（）来使用getfiles函数。
这将允许您选择要浏览的文件夹。对不起，太乱了。你得花几分钟来设置它。但它的作用就像一个符咒。查看页面底部，了解使用getfiles函数仅获取dxf文件的示例。我有各种函数，比如这样，用于获取目录中的某些文件。
模块内容
Option Explicit
Private Declare Function apiShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Type SHITEMID 'mkid
cb As Long 'Size of the ID (including cb itself)
abID As Byte 'The item ID (variable length)
End Type
Type ITEMIDLIST'idl
mkid As SHITEMID
End Type
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Private Declare Function apiGetSystemDirectory& Lib "Kernel32" _
Alias "GetSystemDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long)
Private Declare Function apiGetWindowsDirectory& Lib "Kernel32" _
Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long)
Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
'***App Window Constants***
Public Const WIN_NORMAL = 1 'Open Normal
Public Const WIN_MAX = 3 'Open Maximized
Public Const WIN_MIN = 2 'Open Minimized
Private Const MAX_PATH As Integer = 255
'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal Cx As Long, _
ByVal Cy As Long, ByVal wFlags As Long) As Long
表单内容
Option Explicit
Private Sub cmdIBrowse_Click()
Dim selectFolder As String
Dim bi As BROWSEINFO
Dim idl As ITEMIDLIST
Dim rtn&, pidl&, path$, pos%
'set the type of folder to return
'play with these option constants to see what can be returned
bi.ulFlags = BIF_RETURNONLYFSDIRS'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
'show the browse folder dialog
pidl& = SHBrowseForFolder(bi)
'if displaying the return value, get the selected folder
' If Check1 Then
path$ = Space$(512)
rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
If rtn& Then
'parce & display the folder selection
pos% = InStr(path$, Chr$(0))
selectFolder = Left(path$, pos - 1)
Else
selectFolder = ""
End If
End Sub
Private Sub cmdOBrowse_Click()
Dim selectFolder As String
Dim bi As BROWSEINFO
Dim idl As ITEMIDLIST
Dim rtn&, pidl&, path$, pos%
'set the type of folder to return
'play with these option constants to see what can be returned
bi.ulFlags = BIF_RETURNONLYFSDIRS'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
'show the browse folder dialog
pidl& = SHBrowseForFolder(bi)
'if displaying the return value, get the selected folder
' If Check1 Then
path$ = Space$(512)
rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
If rtn& Then
'parce & display the folder selection
pos% = InStr(path$, Chr$(0))
selectFolder = Left(path$, pos - 1)
Else
selectFolder = ""
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdGO_Click()
Dim FileCountx As Integer
Dim FilesArray() As String
Dim inpath As String
Dim OutPath As String
Dim teststring1 As String
Dim teststring2 As String
Dim MyFilename As String
Dim MyOldFilename As String
Dim MyNewFilename As String
Dim AddText As String
Dim RemoveText As String
FilesArray = GetFiles(inpath)
FileCountx = -1
For FileCountx = LBound(FilesArray) To UBound(FilesArray)
MsgBox MyFilename
'open the file, set the active doc and save it, switch the active doc back,
' open the next and save and so on.
'you can add code to go to a layout in paperspace/modelspace, zoom
'extents, whatever you need.
Next
Unload Me
End Sub
Sub Main()
End Sub
Private Sub Form_Load()
Populate
End Sub
Private Sub Populate()
Dim S As String
Dim PathIName As String
Dim SlashPos As Integer
Dim PathOName As String
'add some form code here
End Sub
Function GetFiles(ByVal FullPath As String) As String()
Dim FileName As String
Dim num_files As Integer
num_files = -1
Dim FilesArray() As String
Dim file_name As String
If Right(FullPath, 1)"\" Then FullPath = FullPath & "\"
FullPath = FullPath & "*.*"
file_name = Dir(FullPath, vbNormal)
Do While Len(file_name) > 0
If FileName"." And FileName".." Then' "\" Then FullPath = FullPath & "\"
FullPath = FullPath & "*.*"
file_name = Dir(FullPath, vbNormal)
Do While Len(file_name) > 0
If FileName"." And FileName".." Then
If Right(file_name, 3) = "dxf" Then
num_files = num_files + 1
ReDim Preserve FilesArray9(0 To num_files)
FilesArray9(num_files) = file_name
Else
GoTo skip
End If
End If
' Get the next file.
skip:
file_name = Dir$()
Loop
GetDxfFiles = FilesArray9
'the array is filled
非常感谢您的参与。我现在设法让事情进展顺利。只需要一点微调，但上述信息已经帮助了我很多。 酷，我很高兴你能解决这个问题。
页:
[1]