範例程式：以 SQL 方式操作 Excel

[Chris]

还有《Excel VBA 747个应用范例技巧全集》，博硕文化出版

感謝分享好書資訊。

另，以下是某位網友問我的一個典型 SQL 問題：如何合併 xls 檔中任意數目的工作表？

假設資料檔是『C:\這個檔案有眾多欄位相同的工作表.xls』。所謂『眾多欄位相同的工作表』，就是每個工作表的（第一列）欄位皆相同。

我將程式 post 如下以饗諸君：

Sub merge()
　　Application.ScreenUpdating = False
　　Application.DisplayAlerts = False
　　Dim s As Integer
　　While ActiveWorkbook.Sheets.Count > 1
　　　　Sheets(1).Delete
　　Wend
　　Sheets(1).Name = "Tables"
　　
　　Cells.Clear
　　
　　Dim c As ADODB.Connection
　　Set c = CreateObject("ADODB.Connection")
　　c.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};Dbq=C:\這個檔案有眾多欄位相同的工作表.xls"
　　c.Open

　　Dim r As ADODB.Recordset
　　Set r = c.OpenSchema(adSchemaTables)
　　Range("A1").CopyFromRecordset r
　　c.Close

　　Sheets.Add After:=Sheets(1)

　　Dim i, t, f As Integer
　　t = Sheets(1).UsedRange.Rows.Count
　　For i = 1 To t
　　　　c.Open
　　　　Set r.ActiveConnection = c
　　　　r.Open ("select * from [" + Sheets(1).Cells(i, 3) + "]")
　　　　If i = 1 Then
　　　　　　For f = 0 To r.Fields.Count - 1
　　　　　　　　Sheets(2).Cells(1, f + 1) = r.Fields(f).Name
　　　　　　Next
　　　　End If
　　　　Sheets(2).Cells(Sheets(2).UsedRange.Rows.Count + 1, 1).CopyFromRecordset r
　　　　c.Close
　　Next
　　Sheets(2).Cells.EntireColumn.AutoFit
　　Sheets(2).Name = "合併結果"

　　Sheets(1).Delete
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
End Sub

本主題係由 [書籍推薦]EXCEL巨集魔法書 分拆的。

[Chris]

後來，他又問到那應該如何合併 mdb 檔案中的 table(s)，其實原理是完全一樣的，只不過資料庫連線字串改一下、以及過濾 Table 即可（SYSTEM TABLE 不要抓它）。
 
請將 mdb 檔與以下程式碼都複製至 c:\ 根目錄下。

程式碼如下：

Sub merge()
　　Application.ScreenUpdating = False
　　Application.DisplayAlerts = False
　　Dim s As Integer
　　While ActiveWorkbook.Sheets.Count > 1
　　　　Sheets(1).Delete
　　Wend
　　Sheets(1).Name = "Tables"
　　
　　Cells.Clear
　　
　　Dim c As ADODB.Connection
　　Set c = CreateObject("ADODB.Connection")
　　c.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydata.mdb"
　　c.Open

　　Dim r As ADODB.Recordset
　　Set r = c.OpenSchema(adSchemaTables)
　　Range("A1").CopyFromRecordset r
　　c.Close

　　Sheets.Add After:=Sheets(1)

　　Dim i, t, f As Integer
　　t = Sheets(1).UsedRange.Rows.Count
　　For i = 1 To t
　　　　If Sheets(1).Cells(i, 4) = "TABLE" Then
　　　　　　c.Open
　　　　　　Set r.ActiveConnection = c
　　　　　　r.Open ("select * from [" + Sheets(1).Cells(i, 3) + "]")
　　　　　　If i = 1 Then
　　　　　　　　For f = 0 To r.Fields.Count - 1
　　　　　　　　　　Sheets(2).Cells(1, f + 1) = r.Fields(f).Name
　　　　　　　　Next
　　　　　　End If
　　　　　　Sheets(2).Cells(Sheets(2).UsedRange.Rows.Count + 1, 1).CopyFromRecordset r
　　　　　　c.Close
　　　　End If
　　Next
　　Sheets(2).Cells.EntireColumn.AutoFit
　　Sheets(2).Name = "合併結果"

　　Sheets(1).Delete
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
End Sub