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

Ok, I have a macro in excel which is working perfectly.

好的，我在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

I want to modify it so I could read in file path from a text file run the macro and change the file path to another one listed in the text file and so on. As soon as the text file reaches EOF, stop the macro.

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

How should I change the code to make it happen.

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

directory = "O:\test\1"

The file paths in the .txt file are separated by return.

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

Thanks.

谢谢。

2 个解决方案

#1

Adapt as you see fit but you should get the idea!

根据您的需要进行调整，但您应该明白这一点！

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

#2

The full answer is :

完整的答案是：

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

#1