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文件中的文件路径由return返回。

感谢。

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

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

2 个答案: