各シートのルーピングが機能しない

Question

このマクロを書いて、フォルダ内のすべてのファイルをループし、各ファイルの各シートをループします。その後、シート単位でSQLをAccess DBに実行し、結果をシートに返します。問題は、各シートをループしていないことで、debug.printの最後のSelect Caseオプションだけを常に返します。どんな考え？私はスタートシートを静的にセットする必要がありますか？この構造は、他のシナリオでも完全に機能します。 SQLの導入は問題ですか？

コード：あなたは

Select Case ActiveSheet.Name 

を使用しますが、あなたのループはそう、それは常に最初のシート（ワークブックを開いた後にアクティブなデフォルト）を使用しています

For Each sheet In ActiveWorkbook.Worksheets 

ある

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

。
それは次のようになります。

Select Case sheet.Name 

とあなたのケース文がちょうどこのように容易になるだろう：私が見落とし

 Case "Thing"