2013-07-11 36 views
2

好吧,我有一個宏在Excel中完美的工作。如何使用文本文件加載文件路徑爲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分隔。

謝謝。

回答

2

適應你所見,但你應該明白!

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 
+0

試圖執行它,但是對它失去了myslef ... – Saint

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 
相關問題