Dim strPath, Str, objFSO, objFile
strPath = "."
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strPath).Files
    If Lcase(Right(objFile.Name, 4)) = ".txt" Then
        With CreateObject("Adodb.Stream")
           .mode = 3
           .charset = "UTF-8"
           .Open()
           .loadfromfile objFile.Path
           Str = .readtext()
           If InStr(str, Mid(objFile.Name, 1, Len(objFile.Name) - 4)) > 0 Then Exit For
        End With
        With CreateObject("Adodb.Stream")
           .mode = 3
           .Open()
           .WriteText Mid(objFile.Name, 1, Len(objFile.Name) - 4) & vbCrLf & vbCrLf & Str
           .SaveToFile objFile.Path, 2
        End With
    End If
Next
复制代码