感谢您使用微软产品。 您可以使用函数Dir()递归查找驱动器下所有的文件夹。如下例:Function FindDirs(path As String) Dim DirName As String ' SubDirectory Name.
Dim dirNames() As String ' Buffer for directory name entries.
Dim nDir As Integer ' Number of directories in this path.
Dim i As Integer ' For-loop counter. On Error GoTo sysFileERR
If Right(path, 1) <> "\" Then path = path & "\"
' Search for subdirectories.
nDir = 0
ReDim dirNames(nDir)
DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
Or vbSystem) ' Even if hidden, and so on.
Do While Len(DirName) > 0
' Ignore the current and encompassing directories.
If (DirName <> ".") And (DirName <> "..") Then
' Check for directory with bitwise comparison.
If GetAttr(path & DirName) And vbDirectory Then
dirNames(nDir) = DirName
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
List1.AddItem path & DirName ' Uncomment to list
End If ' directories.
sysFileERRCont:
End If
DirName = Dir() ' Get next subdirectory.
Loop ' If there are sub-directories..
If nDir > 0 Then
' Recursively walk into them
For i = 0 To nDir - 1
FindDirs = FindDirs + FindDirs(path & dirNames(i) & "\")
Next i
End IfAbortFunction:
Exit Function
sysFileERR:
If Right(DirName, 4) = ".sys" Then
Resume sysFileERRCont ' Known issue with pagefile.sys
Else
MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
"Unexpected Error"
Resume AbortFunction
End If
End FunctionPrivate Sub Command2_Click()
Dim SearchPath As String, FindStr As String Screen.MousePointer = vbHourglass
List1.Clear
SearchPath = Text1.Text
FileSize = FindDirs(SearchPath) Screen.MousePointer = vbDefault
End SubPrivate Sub Form_Load() Command2.Caption = "Use VB code"
' start with some reasonable defaults
Text1.Text = "e:"
End Sub详细信息和示例代码清参考下面的文章:
HOWTO: Search Directories to Find or List Files (Q185476)
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q185476
- 微软全球技术中心 VB技术支持本帖子仅供CSDN的用户作为参考信息使用。其内容不具备任何法律保障。您需要考虑到并承担使用此信息可能带来的风险。具体事项可参见使用条款(http://support.microsoft.com/directory/worldwide/zh-cn/community/terms_chs.asp)。
为了为您创建更好的讨论环境,请参加我们的用户满意度调查(http://support.microsoft.com/directory/worldwide/zh-cn/community/survey.asp?key=(S,49854782))。
======================
Dim dirNames() As String ' Buffer for directory name entries.
Dim nDir As Integer ' Number of directories in this path.
Dim i As Integer ' For-loop counter. On Error GoTo sysFileERR
If Right(path, 1) <> "\" Then path = path & "\"
' Search for subdirectories.
nDir = 0
ReDim dirNames(nDir)
DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
Or vbSystem) ' Even if hidden, and so on.
Do While Len(DirName) > 0
' Ignore the current and encompassing directories.
If (DirName <> ".") And (DirName <> "..") Then
' Check for directory with bitwise comparison.
If GetAttr(path & DirName) And vbDirectory Then
dirNames(nDir) = DirName
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
List1.AddItem path & DirName ' Uncomment to list
End If ' directories.
sysFileERRCont:
End If
DirName = Dir() ' Get next subdirectory.
Loop ' If there are sub-directories..
If nDir > 0 Then
' Recursively walk into them
For i = 0 To nDir - 1
FindDirs = FindDirs + FindDirs(path & dirNames(i) & "\")
Next i
End IfAbortFunction:
Exit Function
sysFileERR:
If Right(DirName, 4) = ".sys" Then
Resume sysFileERRCont ' Known issue with pagefile.sys
Else
MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
"Unexpected Error"
Resume AbortFunction
End If
End FunctionPrivate Sub Command2_Click()
Dim SearchPath As String, FindStr As String Screen.MousePointer = vbHourglass
List1.Clear
SearchPath = Text1.Text
FileSize = FindDirs(SearchPath) Screen.MousePointer = vbDefault
End SubPrivate Sub Form_Load() Command2.Caption = "Use VB code"
' start with some reasonable defaults
Text1.Text = "e:"
End Sub详细信息和示例代码清参考下面的文章:
HOWTO: Search Directories to Find or List Files (Q185476)
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q185476
- 微软全球技术中心 VB技术支持本帖子仅供CSDN的用户作为参考信息使用。其内容不具备任何法律保障。您需要考虑到并承担使用此信息可能带来的风险。具体事项可参见使用条款(http://support.microsoft.com/directory/worldwide/zh-cn/community/terms_chs.asp)。
为了为您创建更好的讨论环境,请参加我们的用户满意度调查(http://support.microsoft.com/directory/worldwide/zh-cn/community/survey.asp?key=(S,49854782))。
======================
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货