텍스트 파일을 사용하여 파일 경로를로드하여 매크로를 엑셀로 변환하는 방법

Question

좋아, 매크로가 완벽하게 작동합니다.

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