```vb
Option Explicit
Private Const LB_SETHORIZONTALEXTENT = &H194
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

  Private Sub Command1_Click()
          Dim ff    As String
          Dim fn     As Long
          Dim i     As Long
          Dim Fpath As String
          Dim obj As Object

          For Each obj In Me '.Frame1
            If TypeOf obj Is CheckBox Then
                 'obj.Value = True
                If obj.Value = 1 Then
                     Fpath = Left(obj.Caption, 1) & ":"
                    ' MsgBox Fpath
                      Call FindAllFolder(Fpath)
                End If
            End If
          Next

         ' Fpath = Text1.Text
         ' If Len(Fpath) = 1 Then Fpath = Fpath & ":"

  End Sub

  Private Function FindAllFolder(ByVal FilePath As String)
          Dim lngIndex      As Long
          Dim strDir        As String
          Dim strSubDirs()  As String
          Dim sFiles As String
          If Right(FilePath, 1) <> "\" Then ''''追加路径
                  FilePath = FilePath & "\"
          End If

          strDir = Dir(FilePath & "*.*") '''获得当前的路径

          Do While Len(strDir) '''''遍历当前文件夹的文件
              DoEvents

              sFiles = FilePath & strDir
              List1.AddItem sFiles
              strDir = Dir
          Loop

          lngIndex = 0
          strDir = Dir(FilePath & "*.*", 16)
          Do While Len(strDir)
            DoEvents
             If Left(strDir, 1) <> "." Then
                If GetAttr(FilePath & strDir) And vbDirectory Then
                    lngIndex = lngIndex + 1
                    ReDim Preserve strSubDirs(1 To lngIndex)
                    strSubDirs(lngIndex) = FilePath & strDir & "\"
                End If
             End If
             strDir = Dir  '''''文件夹下的所有文件 dir("")
          Loop

          For lngIndex = 1 To lngIndex
                DoEvents
                Call FindAllFolder(strSubDirs(lngIndex)) '''递归调用
          Next lngIndex
  End Function
Private Sub Form_Load()
    SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, 500, 0 '''''list1 添加水平滚动条！
End Sub
```