VB6.0获取路径及文件信息问题

Question

我用VB6.0编程，我需要读取一个目录，这个目录（路径）显示在文本框中（text1.text），类似：D:\DICOMFILE\20250104\111\222，在222文件夹后可能存在多级目录，（如222文件夹下存在333文件夹，333文件夹下存在444、555、666文件夹），总之在最后一级文件夹中存放数量不等的.dcm文件。窗体中有一个ListView1控件，第一列：编号，第二列：最后一个子文件夹路径，第三列，最后一个子文件夹中dcm文件数量。点击按钮时，在ListView1中显示对应的数据信息。
运行代码后，总是在函数的这里： TraverseFoldersAndFillListView (subFolder)，提示需要对象
这是代码顶端（是vb6.0，不是vb.net，代码块里没有vb6.0的选项）：

Dim fso As Object

这是按钮：

Private Sub Command1_Click()
Dim folderPath As String
    Dim startFolder As Object
    Dim subFolder As Object
    Dim file As Object
    Dim dcmCount As Long
    Dim lastSubFolder As String
    Dim listItem As listItem
    
    ' 从文本框中获取文件夹路径
    folderPath = Text1.Text
    
    ' 检查路径是否存在
    If Not fso.FolderExists(folderPath) Then
        MsgBox "指定的文件夹路径不存在，请检查并重试。", vbExclamation
        Exit Sub
    End If
    
    ' 获取起始文件夹对象
    Set startFolder = fso.GetFolder(folderPath)
    
    ' 清空 ListView 控件
    ListView1.ListItems.Clear
    
    ' 调用递归函数来遍历文件夹并填充 ListView
    Call TraverseFoldersAndFillListView(startFolder)
End Sub

这是函数：

Private Sub TraverseFoldersAndFillListView(ByVal folder As Object)
    Dim subFolder As Object
    Dim file As Object
    Dim dcmCount As Long
    
    ' 遍历当前文件夹中的每个子文件夹
    For Each subFolder In folder.SubFolders
        dcmCount = 0
        
        ' 检查是否是最后一级文件夹（即没有子文件夹）
        If subFolder.SubFolders.Count = 0 Then
            ' 遍历子文件夹中的每个文件
            For Each file In subFolder.Files
                ' 检查文件扩展名是否为.dcm
                If fso.GetExtensionName(file.Path) = "dcm" Then
                    dcmCount = dcmCount + 1
                End If
            Next file
            
            ' 如果是最后一级文件夹且有.dcm文件，则添加到 ListView
            If dcmCount > 0 Then
            Dim listItem As listItem
                Set listItem = ListView1.ListItems.Add()
                listItem.SubItems(1) = CStr(ListView1.ListItems.Count + 1) ' 编号
                listItem.SubItems(2) = subFolder.Path ' 最后一个子文件夹路径
                listItem.SubItems(3) = CStr(dcmCount) ' .dcm文件数量
                 
            End If
        Else
            ' 如果不是最后一级文件夹，则递归调用
            TraverseFoldersAndFillListView (subFolder)
        End If
    Next subFolder
End Sub

这是窗体加载时的LISTVIEW情况：

 With ListView1
   .View = lvwReport
   .ColumnHeaders.Add = "编号"
   .ColumnHeaders.Add = "子文件夹名"
   .ColumnHeaders.Add = "dcm数量"
   .ColumnHeaders(1).width = 400
   .ColumnHeaders(2).width = 2000
   .ColumnHeaders(3).width = 1000
    End With

Answer 1

让【道友老李】来帮你解答，本回答参考gpt编写，并整理提供，如果还有疑问可以点击头像关注私信或评论！

如果答案让您满意，请采纳、关注，非常感谢！

问题分析：

1. 代码中使用的fso对象未进行实例化，导致在运行时提示需要对象。
2. 函数TraverseFoldersAndFillListView中递归调用时，应当将传递的参数去掉括号。
3. 在ListView1中显示数据时，需要根据子文件夹是否为最后一级决定是否递归调用函数。 解决方法：
4. 在代码顶端实例化fso对象：

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

1. 修改函数TraverseFoldersAndFillListView中的递归调用部分，去掉括号：

TraverseFoldersAndFillListView subFolder

1. 在ListView1中显示数据时，根据条件判断是否递归调用函数：

If subFolder.SubFolders.Count = 0 And dcmCount > 0 Then
    ' 添加到 ListView
Else
    ' 递归调用
End If

示例代码：

Private Sub Command1_Click()
    Dim folderPath As String
    Dim startFolder As Object
    Dim subFolder As Object
    Dim file As Object
    Dim dcmCount As Long
    Dim lastSubFolder As String
    Dim listItem As listItem
    ' 实例化文件系统对象
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 从文本框中获取文件夹路径
    folderPath = Text1.Text
    ' 检查路径是否存在
    If Not fso.FolderExists(folderPath) Then
        MsgBox "指定的文件夹路径不存在，请检查并重试。", vbExclamation
        Exit Sub
    End If
    ' 获取起始文件夹对象
    Set startFolder = fso.GetFolder(folderPath)
    ' 清空 ListView 控件
    ListView1.ListItems.Clear
    ' 调用递归函数来遍历文件夹并填充 ListView
    TraverseFoldersAndFillListView startFolder
End Sub
Private Sub TraverseFoldersAndFillListView(ByVal folder As Object)
    Dim subFolder As Object
    Dim file As Object
    Dim dcmCount As Long
    ' 遍历当前文件夹中的每个子文件夹
    For Each subFolder In folder.SubFolders
        dcmCount = 0
        ' 检查是否是最后一级文件夹（即没有子文件夹）
        If subFolder.SubFolders.Count = 0 Then
            ' 遍历子文件夹中的每个文件
            For Each file In subFolder.Files
                ' 检查文件扩展名是否为.dcm
                If fso.GetExtensionName(file.Path) = "dcm" Then
                    dcmCount = dcmCount + 1
                End If
            Next file
            ' 添加到 ListView
            If dcmCount > 0 Then
                Dim listItem As listItem
                Set listItem = ListView1.ListItems.Add()
                listItem.SubItems(1) = CStr(ListView1.ListItems.Count + 1) ' 编号
                listItem.SubItems(2) = subFolder.Path ' 最后一个子文件夹路径
                listItem.SubItems(3) = CStr(dcmCount) ' .dcm文件数量
             End If
        Else
            ' 递归调用
            TraverseFoldersAndFillListView subFolder
        End If
    Next subFolder
End Sub

通过以上修改后的代码，应能正确遍历目录并在ListView1中显示相应数据信息。