VBA卡在嵌套循环中

Question

我正在编写一个将工作簿 (fromWB) 名称 (tempName) 的前几个字符与工作表名称 (sheetName) 进行比较的代码。如果它们匹配，则将文件中的数据复制到工作表 (ws) 中。我试图让我的代码遍历文件文件夹和具有多个工作表的工作簿（fromWB），但代码卡在 do while 循环中（遍历工作表），我不知道如何修理它。它停止复制并粘贴到工作表中，因为 tempName 没有更改，因为代码没有循环遍历文件文件夹。我调试了代码，我没有收到任何错误。任何帮助将不胜感激！

编辑：两个嵌套的 For Each 循环会起作用吗？

Sub Import(Optional sPath As Variant)
Dim SelectFolder As FileDialog
Dim fromWB As Workbook
Dim toWB As Workbook
Dim ws As Worksheet
Dim fileName As String
Dim sheetName As String
Dim tempName As String


'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
'Application.EnableEvents = False

'Retrieve Target Folder Path From User
Set SelectFolder = Application.FileDialog(msoFileDialogFolderPicker)

With SelectFolder
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    sPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
sPath = sPath
If sPath = "" Then GoTo ResetSettings

sFile = Dir(sPath & "*xlsx")
Workbooks("Temp.xlsx").Activate
Set toWB = ActiveWorkbook

Do While sFile <> ""
    Set fromWB = Workbooks.Open(sPath & sFile)
    tempName = Left(sFile, 3)
    Range("A1:B10").Select
    Selection.Copy

    For Each ws In toWB.Worksheets
        Windows("Temp.xlsx").Activate
        sheetName = ActiveSheet.Name
        If sheetName = tempName Then
            ws.Activate
            Range("A4").PasteSpecial xlPasteAllUsingSourceTheme
        End If
        ws.Activate
    Next ws
sFile = Dir()
Loop


ResetSettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Answer 1

我认为您的 for each 循环没有问题。在我看来，它会卡在 do while 循环中。

您不会在循环中的任何地方更改 sFile，因此它永远不会中断。

Do While sFile <> ""

Loop

编辑：

Sub LoopThroughFiles()
    Dim MyObj As Object, MySource As Object, file As Variant
    file = Dir("c:\testfolder\")
    While (file <> "")
      'code here
      file = Dir
    Wend
End Sub

发件人：Loop through files in a folder using VBA?