想利用ACCESS來從「同欄位不同內容的多個檔案」中查詢特定幾筆資料

稻草人到處草人 wrote:
各位好：之前我提過access...(恕刪)

zchiang wrote:
以下是利用查詢來查一(恕刪)

稻草人到處草人 wrote:
因為假設可以分開資料表的話，我至少還可以依照月份的來使用「已儲存的匯入」來更新

這個問題有辦法解決嗎？

chuway wrote:
每個月一個檔嗎?

'簡易範例，請參考
'測試用access資料庫，請自行照上面圖片的格式建立(名稱暫訂test.accdb)，存放位置同excel檔
'程式碼打完後，需先存檔關閉後再開

Sub List_All_Table()


    Dim DB As Object, RS As Object, All_Table As Object, Table, Skip_Table, Sql As String, lastrow As Double, ttt As Double
    
    Set DB = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")
    Set All_Table = CreateObject("ADOX.catalog")
    
    DB.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.Path & "\test.accdb" & ";"
    All_Table.ActiveConnection = DB
    
    Cells.Clear
    Application.ScreenUpdating = False
 
    
    Skip_Table = Array("資料表1", "資料表2") '跳過格式不同的表格，(,逗點隔開)
    查詢 = "aaa" '暫訂查收件人
    lastrow = 1
    Sql = ""
    Range("a1:c1") = Array(查詢, "日期", "單號")
    ttt = Timer
    
    
    If All_Table.tables.Count < 50 Then
        
        '少量資料表  UNION ALL，只需使用sql查詢1次
        For i = 0 To All_Table.tables.Count - 1
            
            If All_Table.tables.Item(i).Type = "TABLE" And Join(Filter(Skip_Table, All_Table.tables.Item(i).Name)) = "" Then
                Sql = Sql & "SELECT 日期,單號 from " & All_Table.tables.Item(i).Name & " WHERE 收件人='" & 查詢 & "'" & " UNION ALL "
            End If
   
        Next i
        
        Sql = Left(Sql, Len(Sql) - 11)
        RS.Open Sql, DB, 3, 3
        Cells(lastrow + 1, 2).CopyFromRecordset RS
        RS.Close
        
    Else
        
        '大量資料表，N次sql查詢
        For i = 0 To All_Table.tables.Count - 1
            
            If All_Table.tables.Item(i).Type = "TABLE" And Join(Filter(Skip_Table, All_Table.tables.Item(i).Name)) = "" Then
        
                Sql = "SELECT 日期,單號 from " & All_Table.tables.Item(i).Name & " WHERE 收件人='" & 查詢 & "'"
                RS.Open Sql, DB, 3, 3
                Cells(lastrow + 1, 2).CopyFromRecordset RS
                lastrow = lastrow + RS.RecordCount
                RS.Close
            
            End If
   
        Next i
        
    End If
    
      
    Debug.Print Timer - ttt & "s"
    Application.ScreenUpdating = True
    
    DB.Close
    Set All_Table = Nothing
    Set DB = Nothing
    Set RS = Nothing
    
End Sub