Sub test()
Dim mFolder As String
Dim i As Integer
Dim k As IntegerDim MyDate
MyDate = Date
Range("AD3").Value = MyDatek = 6    mFolder = ThisWorkbook.Path
    [A4] = "路径"
    '[B1] = "文件名"
    With Application.FileSearch
        .NewSearch
        .LookIn = mFolder
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
          
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                If .FoundFiles(i) <> ThisWorkbook.FullName Then
                   Call Write_In(.FoundFiles(i))
                End If
                
                If i Mod 2 = 0 Then
                Range("B" & k & ":AD" & k + 1).Select
                 With Selection.Interior
                   .ColorIndex = 8
                   .Pattern = xlSolid
                 End With
                End If
               k = k + 2
            Next i
        Else
            MsgBox "文件夹 " & mFolder & "中没有所需的文件"
        End If
    End With
    Range("A4:A80").Clear
     
End Sub