首先，要定義連接的數據集

    Set objRec = CreateObject("ADODB.Recordset")Set objConn = CreateObject("ADODB.Connection")

然后在代碼中要定義SQL語句，以便獲取數據

 sqlstr = sqlstr + "  select t1.FBillNo ,t_Item.fname type,t1.FNote,t2.FNumber,t2.FName, t2.FModel,t1.FQty,  "sqlstr = sqlstr + " convert(varchar,T1.FCommitDate,23) rwxdrq,convert(varchar,t1.fheadselfj01111,23) rkrq,   "sqlstr = sqlstr + "t4.FItemID,t4.FName,t3.Fmaketime   from icmo t1 inner join t_icitem  t2 on t1.fitemid=t2.FItemID "sqlstr = sqlstr + " left join t_BOS257800028Entry2  t3  on t3.FID_SRC=t1.FInterID and t3.FBillNo_SRC1=t1.FBillNo "sqlstr = sqlstr + " left join t_Item_3005 t4 on t3.FBase4=t4.FItemID "sqlstr = sqlstr + " left join t_Item on t_item.fitemid=t1.FHeadSelfJ01100 and t_item.FItemClassID=3002 "sqlstr = sqlstr + "where t1.fheadselfj01111 >=" & "'" & Sdate & "'" & "  and t1.fheadselfj01111<=" & "'" & Edate & "'"

有三個方案用來獲取數據
方法一

    '連接數據庫并執行SQL語句objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=192.168.100.3;Initial Catalog=AIS20150813141843;User ID=sa;Password=Chr_2016"objConn.OpenSet objRec = objConn.Execute(sqlstr)If Not objRec.EOF Then'將結果集保存到工作表Set WS = ThisWorkbook.Worksheets(sheetName) ''將標題寫入工作表For i = 0 To objRec.Fields.count - 1WS.Cells(1, i + 1).Value = objRec.Fields(i).NameNext iActiveSheet.Range("A2").CopyFromRecordset objRec'''    關閉記錄集和連接objRec.CloseobjConn.Close
''    '釋放對象Set objRec = NothingSet objConn = NothingElseMsgBox "沒有數據，請重新選擇時間段"Exit SubEnd If

方法二，這段代碼在WPS下能夠執行，但在EXCEL下會報錯

''     執行查詢并將結果存儲在記錄集對象中
''    '連接數據庫并執行SQL語句objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=192.168.100.3;Initial Catalog=AIS20150813141843;User ID=sa;Password=Chr_2016"objConn.OpenobjRec.Open sqlstr, objConnIf Not objRec.EOF Then''     設置工作表對象Set WS = ThisWorkbook.Sheets(sheetName) ' 可以更改為你要寫入數據的工作表名稱
''     將數據寫入工作表With WS.QueryTables.Add(Connection:=objRec, Destination:=WS.Range("A1")).RefreshEnd With'''    關閉記錄集和連接objRec.CloseobjConn.Close
''    '釋放對象Set objRec = NothingSet objConn = NothingElseMsgBox "沒有數據，請重新選擇時間段"Exit SubEnd If

在EXCEL中執行時，會提示

方法三，由于方法二在EXCEL中執行會有問題，經查詢資料，使用ListObjects的方法進行。但此方法在EXCEL中能執行，WPS中執行會報錯(WPS中無ListObject對象)

  ActiveWorkbook.Queries.Add Name:="查詢1", Formula:= _"let" & Chr(13) & "" & Chr(10) & "    源 = Odbc.Query(""dsn=CHR"", """ & sqlstr & """)" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    源" & ""''     設置工作表對象Set WS = ThisWorkbook.Sheets(sheetName) ' 可以更改為你要寫入數據的工作表名稱With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=查詢1;Extended Properties=""""" _, Destination:=WS.Range("$A$1")).QueryTable.CommandType = xlCmdSql.CommandText = Array("SELECT * FROM [查詢1]").RowNumbers = False.Refresh BackgroundQuery:=True '后臺進行查詢，false時會跳出對話框End WithActiveWorkbook.Queries(1).Delete '刪除查詢

如果系統設置過ODBC，也可以將連接語句設置如下

dim connstring as stringconnString = "DRIVER={ODBC Driver 17 for SQL Server};" & _"SERVER=192.168.100.3;" & _"DATABASE=AIS20150813141843;" & _"UID=sa;" & _"PWD=Chr_2016;"