2

わかりました、完全に機能している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 ファイル内のファイル パスは改行で区切られています。

ありがとう。

4

2 に答える 2

0

完全な答えは次のとおりです。

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
于 2013-07-12T10:59:03.930 に答える