引用:https://blog.csdn.net/a572893208/article/details/102150552
VBA中查詢EXCEL數據源,其中 [LMSData2016.12$] 代表工作表名,如果是部分內容range查詢,可以將表格使用【名稱管理器】進行替換. 【公式】--【名稱管理器】
Sub Query()
Dim Conn As Object, Rst As Object
Dim strConn As String, strSQL As String
Dim i As Integer, PathStr As String
Set Conn = CreateObject("ADODB.Connection")
Set Rst = CreateObject("ADODB.Recordset")
PathStr = ThisWorkbook.FullName '設置工作簿的完整路徑和名稱
Select Case Application.Version * 1 '設置連接字符串,根據版本創建連接
Case Is <= 11
strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
Case Is >= 12
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
End Select
'設置SQL查詢語句
strSQL = "SELECT DISTINCT 發站 FROM [LMSData2016.12$]"
Conn.Open strConn '打開數據庫鏈接
Set Rst = Conn.Execute(strSQL) '執行查詢,並將結果輸出到記錄集對象
With Sheet1
.Cells.Clear
For i = 0 To Rst.Fields.Count - 1 '填寫標題
.Cells(1, i + 1) = Rst.Fields(i).Name
Next i
.Range("A2").CopyFromRecordset Rst
.Cells.EntireColumn.AutoFit '自動調整列寬
End With
Rst.Close '關閉數據庫連接
Conn.Close
Set Conn = Nothing
Set Rst = Nothing
End Sub