VBA 引用从SQL数据库取数据的几个方法

首先，要定义连接的数据集

    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;"