vba - 如何使用文本文件将文件路径加载到excel宏

Question

好的，我在 excel 中有一个运行良好的宏。

Sub FindOpenFiles()
Dim FSO As Scripting.FileSystemObject, folder As Scripting.folder, file As Scripting.file, wb As Workbook, sh As Worksheet
Dim directory As String

    directory = "O:\test\1"

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(directory)


    For Each file In folder.Files
        If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xls" Then
            Workbooks.Open directory & Application.PathSeparator & file.Name

        Set wb = Workbooks("Equipment Further Documentation List.xls")
    For Each sh In Workbooks("1.xls").Worksheets
        sh.Copy After:=wb.Sheets(wb.Sheets.Count)
    Next sh

     ActiveWorkbook.Close SaveChanges:=True
     ActiveWorkbook.CheckCompatibility = False

        End If

    Next file
End Sub

我想修改它，以便我可以从文本文件中读取文件路径运行宏并将文件路径更改为文本文件中列出的另一个路径，依此类推。文本文件到达 EOF 后，立即停止宏。

我应该如何更改代码以实现它。

directory = "O:\test\1"

.txt 文件中的文件路径由回车分隔。

谢谢。

Answer 1

适应你认为合适的，但你应该明白的！

Const ForReading = 1
Set oFSO = New FileSystemObject


Dim txtStream As textStream


Set txtStream = oFSO.OpenTextFile("C:\....\PathtoFiles.txt", ForReading)

Do Until txtStream.AtEndOfStream
    strNextLine = txtStream.ReadLine
    If strNextLine <> "" Then
        ' Do something?
    End If
Loop
txtStream.Close

Answer 2

完整的答案是：

Sub FindOpenFiles()

Const ForReading = 1
Set oFSO = New FileSystemObject

Dim txtStream As TextStream

Dim FSO As Scripting.FileSystemObject, folder As Scripting.folder, file As Scripting.file, wb As Workbook, sh As Worksheet
Dim directory As String

Set txtStream = oFSO.OpenTextFile("C:\Users\GrzegoP\Desktop\Project\test\paths.txt", ForReading)

Do Until txtStream.AtEndOfStream
    strNextLine = txtStream.ReadLine
    If strNextLine <> "" Then

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(strNextLine)


    For Each file In folder.Files
        If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xls" Then
            Workbooks.Open directory & Application.PathSeparator & file.Name

        Set wb = Workbooks("Equipment Further Documentation List.xls")
    For Each sh In Workbooks("1.xls").Worksheets
        sh.Copy After:=wb.Sheets(wb.Sheets.Count)
    Next sh

     ActiveWorkbook.Close SaveChanges:=True
     ActiveWorkbook.CheckCompatibility = False

        End If
    End If

    Next file

    Loop
txtStream.Close
End Sub