VBA：Excel使用SQL進行查詢

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