在每张纸上循环不工作

I wrote this macro to loop through all files in a folder and loop through each sheet in each file. Then on a per sheet basis run SQL to an Access DB and return results to a sheet. Problem is is that it isnt looping through each sheet, and constantly returns only the last Select Case option in debug.print. Any idea why? Do i need to statically set start sheet? This structure works perfectly in other scenarios. Is the introduction of SQL the issue?

我写了这个宏来循环遍历文件夹中的所有文件,并循环遍历每个文件中的每个工作表。然后在每张纸上运行SQL到Access DB并将结果返回到工作表。问题是它不是循环遍历每个工作表,并且不断地仅返回debug.print中的最后一个Select Case选项。知道为什么吗?我需要静态设置开始表吗?此结构在其他方案中完美运行。是SQL的引入问题吗?

code:

Private Sub attempttomindeIDs()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strConnection As String
Dim i As Integer, fld As Object
Dim vAriable As Long
Dim sheet As Worksheet
Dim wsO As Worksheet
Dim wbk As Workbook
Dim Filename As String
Dim path As String
Dim rCell As Range
Dim rRng As Range
Dim StartTime As Double
Dim SecondsElapsed As Double

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

' MS OFfice 15.0 Access Database engine object

StartTime = Timer

Set db = DBEngine.OpenDatabase("pathtoDB" & "\" & "Microsoft1.accdb")

path = "pathtofolder" & "\"
Filename = Dir(path & "*.xl??")
Set wsO = ThisWorkbook.Sheets("Sheet1")

Do While Len(Filename) > 0
    DoEvents
    Set wbk = Workbooks.Open(path & Filename, True, True)
    For Each sheet In ActiveWorkbook.Worksheets
    If sheet.Index > 1 Then
    Set rRng = sheet.Range("b2:b308")
        For Each rCell In rRng.Cells
            If rCell <> "" Then
                vAriable = rCell

                Debug.Print " name "; ActiveSheet.Name

                Select Case ActiveSheet.Name
                    Case Is = "Thing"
                        vAr2 = "[Thing]"
                    Case Is = "There"
                        vAr2 = "[There]"
                    Case Is = "That"
                        vAr2 = "[That]"
                    Case Is = "This"
                        vAr2 = "[This]"
                End Select

                Set rst = db.OpenRecordset("SELECT [ID], [Column] FROM " & vAr2 & " WHERE [ID] =" & vAriable)

                wsO.Cells(Sheet1.Rows.Count, 1).End(xlUp).Offset(1, 0).CopyFromRecordset rst
                wsO.Columns(7).Cells(Sheet1.Rows.Count, 1).End(xlUp).Offset(1, 0) = Right(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - InStr(ActiveWorkbook.Name, "/"))
                wsO.Columns(9).Cells(Sheet1.Rows.Count, 1).End(xlUp).Offset(1, 0) = ActiveSheet.Name

            End If
        Next rCell
        End If
    Next
    wbk.Close False
    Filename = Dir
Loop

rst.Close
Set rst = Nothing
db.Close
Set db = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

1 个解决方案

#1

You use

Select Case ActiveSheet.Name

but your loop is

但你的循环是

For Each sheet In ActiveWorkbook.Worksheets

so it always uses the first sheet (default active after opening the workbook).
It should be:

所以它总是使用第一张表(打开工作簿后默认处于活动状态)。它应该是:

Select Case sheet.Name

and your case statements would be easier just like this:

你的案例陈述就像这样容易:

     Case "Thing"

#1