[英]Open All File in All Folder Path Then Skip to Empty Folder
我需要在每個文件夾中打開文件復制並粘貼,但代碼停止下一個循環。
我參考的代碼https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/
這里的代碼已經試過了(代碼在下一個 i 停止)
Option Explicit
Sub LoopAllFilesInFolder()
Dim folderName As String
Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim FSOFile As Object
Dim i As Long, LastRow As Long
Dim Ws As Worksheet
Dim Ws2 As Worksheet
'DATA
Dim A As Variant
Dim B As Worksheet
Dim C As Workbook
Set Ws = ThisWorkbook.Worksheets("Path_Import")
Set Ws2 = ThisWorkbook.Worksheets("DATA_ORDER")
LastRow = Ws.Range("G11").End(xlDown).Row
Ws.Activate
For i = 11 To LastRow
'Set the file name to a variable
folderName = Range("G" & i).Value
If folderName <> VBA.Constants.vbNullString Then
'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(folderName)
Set FSOFile = FSOFolder.Files
'Use For Each loop to loop through each file in the folder
For Each FSOFile In FSOFile
Set A = Application.Workbooks.Open(FSOFile)
Set B = A.Sheets(1)
B.Cells(Rows.Count, 1).End(xlUp).Offset(0, 28).Select
Range(Selection, Cells(1, 1)).Copy
If Ws2.Range("A1") = "" Then
Ws2.Cells(Rows.Count, 1).End(xlUp).PasteSpecial 'xlPasteValues
Else
Ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial 'xlPasteValues
End If
A.Close SaveChanges:=False
Next
'Release the memory
Set FSOLibrary = Nothing
Set FSOFolder = Nothing
Set FSOFile = Nothing
End If
Next i
End Sub
您需要更改循環 for 語句
For Each FSOFile In FSOFile
至
For Each FSOFile In FSOFolder.Files
並刪除行Set FSOFile = FSOFolder.Files
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.