循環遍歷每張紙不工作

我寫了這個宏來遍歷文件夾中的所有文件，並循環遍歷每個文件中的每張紙。然後在每個表的基礎上運行SQL到Access數據庫並將結果返回到工作表。問題在於它沒有循環遍歷每個工作表，並不斷返回debug.print中的最後一個Select Case選項。任何想法爲什麼？我是否需要靜態設置啓動表單？這種結構在其他情況下完美工作。 SQL的引入是否是問題？循環遍歷每張紙不工作

代碼：

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

來源

2016-07-27 Doug Coats

您使用

Select Case ActiveSheet.Name

，但你的循環是

For Each sheet In ActiveWorkbook.Worksheets

所以它總是使用第一張（默認主動打開工作簿後）。
它應該是：

Select Case sheet.Name

和你的case語句會更容易些，就像這樣：

 Case "Thing"

來源

2016-07-27 19:44:04 Andre

當然AAAAAAAAnd它的一些愚蠢的我忽略了。非常感謝 –

@DougCoats - 當您處於這種狀態時，我會用'For Each sheet In wbk.Worksheets'替換'For Each Sheet In ActiveWorkbook.Worksheets'。捕獲參考然後不使用它沒有任何意義。同樣在這個循環中的其他地方。 – Comintern

我慢慢得到這個笑聲的感謝:) –

循環遍歷每張紙不工作

回答

相關問題