Looping Through Each Sheet not Working

Question

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?

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

Answer 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"