按日期读取文本文件并将其复制到活动工作表中

Read and copy text files by date into active worksheet

我正在尝试创建一个从文件夹中读取每个 *.txt 文件的宏,如果修改日期与当前文件匹配,则将内容复制到 *.xls 文件的工作表中。我一直在检查你在这里分享的很多代码,但我就是不能让它工作。

调试时,在第8行出现错误:

438: Object doesn't support this property or method

Sub GetSAPfiles()
    Dim Cont As Integer
    Dim RootDir As String
    RootDir = "\HOME\SAP\dir\"
    SAPfile = Dir(RootDir)
    Set SAPfile = CreateObject("Scripting.FileSystemObject")
    Set SF = SAPfile.GetFile(RootDir + SAPfile)

    Do While SAPfile <> ""
        Dim ObjDate, CurrDate
        CurrDate = Format(Now(), "MM/DD/YYYY")
        ObjDate = Format(file.DateLastModified, "MM/DD/YYYY")

        If CurrDate = ObjDate Then
            Cont = Cont + 1
            Dim TxtFl, Txt
            Set TxtFl = SAPfile.OpenTextFile(RootDir + SAPfile)
            Txt = TxtFl.ReadLine
            ActiveSheet.Cells(Cont, "A").Value = Txt
            ArchTxt.Close
        End If
        SAPfile = Dir(RootDir)
    Loop
End Sub

试试这样的方法,使用命令提示符获取文件数组并使用 FSO 循环遍历它们以检查修改日期并将文本读入 A 列的下一个空白单元格中:

Sub SO()

   RootDir$ = "\HOME\SAP\dir\"

   For Each x In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR " & RootDir & "*.* /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
       With CreateObject("Scripting.FileSystemObject")
           If DateValue(.GetFile(RootDir & x).DateLastModified) = Date Then _
                 Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = .OpenTextFile(RootDir & x, 1).ReadAll
       End With
   Next x

End Sub