几个关于文件夹中搜索文件的问题

Question

1，比如，我有一个名为customers的文件夹，文件夹下面又有很多记录客户信息的文件夹，文件夹的名字为客户的姓名，现在我要在每个客户文件夹中搜索一个名为"合同.txt"的文件，如果有的话就读取该文件，如果没有的话就将客户的姓名（也就是客户文件夹名）记录到一个文本文件中，一行一个记录。2，我用dirlistbox和driverlistbox做了一个文件夹选择form，如何记录我当前所选择的文件夹的路径？要在customers文件夹展开和不展开时获取的都是customers文件夹的路径。

Answer 1

用fso打开那个.txt文件，如果没有会产生一个error的，明白了没？

Answer 2

On Error Resume Next
        Dim fs, f
        Const ForReading = 1, ForWriting = 2, ForAppending = 3
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.OpenTextFile(strFilePath & "¹¤³ÌÐÅÏ¢.txt", ForReading, False)
        If Err.Number > 0 Then
            logFile.WriteLine (Mydirectory(i + 1))
        End If
        f.Close

Answer 3

On Error Resume Next
        Dim fs, f
        Const ForReading = 1, ForWriting = 2, ForAppending = 3
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.OpenTextFile(strFilePath & "4.txt", ForReading, False)
        If Err.Number > 0 Then
            logFile.WriteLine (Mydirectory(i + 1))
        End If
        f.Close

Answer 4

你可以使用递归方法，实现查找子目录，获得各个目录后可以再判断文件是否存在
dir(filepath & filename)，递归方法，可以在baidu上搜索到原代码，以便你自己可以
参考！

Answer 5

这是我拿来复制文件夹用的，你拿去改改
Silence 是模块变量，bool型
Public Function CopyDirect(ByVal SourcePath As String, ByVal DestPath As String) As Boolean
  Dim folder1 
  Dim file1
  Dim folders1
  Dim files1
  Dim fi
  Dim fs
  Dim tSourcePath As String
  Dim tDestPath As String
  On Error GoTo errmsg
  tSourcePath = SourcePath
  tDestPath = DestPath
  DoEvents
  Set folders1 = Fso1.GetFolder(tSourcePath)
  'create folder in destpath
  If Right(tDestPath, 1) = "\" Then
    tDestPath = Left(tDestPath, Len(tDestPath) - 1)
  End If
  tDestPath = tDestPath & "\" & folders1.Name
  If Not Fso1.FolderExists(tDestPath) Then
    Fso1.CreateFolder tDestPath
  End If
  'sourcepath=sourcepath
  For Each file1 In folders1.Files
    Set fi = Fso1.GetFile(file1)
    'create folder in destpath
    'copy file1 to destpath file1
 '   MsgBox "Copy file from " & file1 & " to " & tDestPath & "\" & fi.Name
     If Len(tDestPath & "\" & fi.Name) > 30 Then
       lblFile.Caption = "正在复制文件：" & Left(tDestPath & "\" & fi.Name, 12) & "......" & Right(tDestPath & "\" & fi.Name, 12)
     Else
       lblFile.Caption = "正在复制文件：" & tDestPath & "\" & fi.Name
     End If
     If Fso1.FileExists(tDestPath & "\" & fi.Name) Then
       If Silence Then
         Fso1.CopyFile file1, tDestPath & "\" & fi.Name, True
       Else
         If MsgBox("文件“" & tDestPath & "\" & fi.Name & "”已经存在，是否覆盖？", vbYesNo + vbQuestion) = vbYes Then
           If MsgBox("是否希望覆盖所有已经存在的文件？", vbInformation + vbYesNo) = vbYes Then
             Silence = True
           End If
           Fso1.CopyFile file1, tDestPath & "\" & fi.Name, True
         End If
       End If
     Else
       Fso1.CopyFile file1, tDestPath & "\" & fi.Name
     End If
     If ProBar.Value < ProBar.Max Then ProBar.Value = ProBar.Value + fi.Size
  Next
  For Each folder1 In folders1.SubFolders
    Set fs = Fso1.GetFolder(folder1)
'    MsgBox "Copy folder from " & folder1 & "  To Destination folder " & tDestPath & "\" & fs.Name
    If Not Fso1.FolderExists(tDestPath & "\" & fs.Name) Then
      Fso1.CreateFolder tDestPath & "\" & fs.Name
    End If
    CopyDirect folder1, tDestPath
  Next
  CopyDirect = True
  Exit Function
errmsg:
  CopyDirect = False
  MsgBox Err.Description, vbCritical
End Function