VBScript将特定的SQL Server数据库列导入到Excel中
我正在开发一个VBScript，其中我需要从MS Excel中的特定表的SQL Server数据库的特定列导入一些值。 我对此没有任何线索。
你可以请我build议我可以实现上述情况的方式。
Option Explicit Const adOpenStatic = 3 Const adLockOptimistic = 3 dim strSqlInsertString,objConnection1,objConnection2,objRecordSet1,objRecordSet2,strSqlInsertString2 dim objExcel,objWorkBook,objWorkbook1,intRow Set objConnection1 = CreateObject("ADODB.Connection") Set objRecordSet1 = CreateObject("ADODB.Recordset") Set objConnection2 = CreateObject("ADODB.Connection") Set objRecordSet2 = CreateObject("ADODB.Recordset") objConnection1.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=appapollo;Password=dna;Initial Catalog=6057;Data Source=lxi282" objConnection2.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=appapollo;Password=dna;Initial Catalog=6057;Data Source=lxi282" Set objExcel = CreateObject("Excel.Application") objExcel.Workbooks.Open("D:\Cardiopacs\Automation\Forward\test.xls") Set objWorkbook = objExcel.ActiveWorkbook.Worksheets(1) Set objWorkbook1 = objExcel.ActiveWorkbook.Worksheets(2) intRow = 2 Dim AEName,AEDescription,AEIPAddress,AEPort,ModifiedDate,QRSSApplicationEntityID,MobileAE,NotificationXML,PreFetch,PreFetchSuffix Dim Enabled,SSDICOMApplicationEntityID,SSDICOMAERoleDescriptionID,AEFunction Do Until objWorkbook.Cells(intRow,1).Value = "" 'SSDIOMApplicationEntityID = objExcel.Cells(intRow, 1).Value AEName = objWorkbook.Cells(intRow, 1).Value AEDescription = objWorkbook.Cells(intRow, 2).Value AEIPAddress = objWorkbook.Cells(intRow, 3).Value AEPort = objWorkbook.Cells(intRow, 4).Value ModifiedDate = objWorkbook.Cells(intRow, 5).Value QRSSApplicationEntityID = objWorkbook.Cells(intRow, 6).Value MobileAE = objWorkbook.Cells(intRow, 7).Value NotificationXML = objWorkbook.Cells(intRow, 8).Value PreFetch = objWorkbook.Cells(intRow, 9).Value PreFetchSuffix = objWorkbook.Cells(intRow, 10).Value strSqlInsertString = "INSERT INTO SSDICOMApplicationEntities (AEName,AEDescription,AEIPAddress,AEPort,ModifiedDate,QRSSApplicationEntityID,MobileAE," & _ "NotificationXML,PreFetch,PreFetchSuffix) " & _ "VALUES('" & AEName & "','" & AEDescription & "','" & AEIPAddress & "','" & AEPort & "','" & ModifiedDate & "','" & QRSSApplicationEntityID & "','" & MobileAE & "'," & _ "'" & NotificationXML & "','" & PreFetch & "','" & PreFetchSuffix & "')" intRow = intRow + 1 set objRecordSet1=objConnection1.execute(strSQLInsertString) loop WScript.Sleep 1000 intRow = 2 Do Until objWorkbook1.Cells(intRow,1).Value = "" Enabled = objWorkbook1.Cells(intRow, 1).Value SSDICOMApplicationEntityID = objWorkbook1.Cells(intRow, 2).Value SSDICOMAERoleDescriptionID = objWorkbook1.Cells(intRow, 3).Value AEFunction = objWorkbook1.Cells(intRow, 4).Value strSqlInsertString2 = "INSERT INTO SSDICOMAERoles (Enabled,SSDICOMApplicationEntityID,SSDICOMAERoleDescriptionID,AEFunction)" & _ "VALUES('" & Enabled & "','" & SSDICOMApplicationEntityID & "','" & SSDICOMAERoleDescriptionID & "','" & AEFunction & "')" intRow = intRow + 1 set objRecordSet1=objConnection1.execute(strSQLInsertString2) loop objConnection1.close set objConnection1 = Nothing objExcel.Quit 在上面的代码中，我想从DATABASE中检索SSDICOMApplicationEntityID的值，并希望放入Excel中。 目前我手动插入到Excel中。
这是一个使用VBA以另一种方式移动数据的简单例子，您需要做一些转换，但我猜测的不是太多：
Option Explicit Global Const strC As String = _ "PROVIDER=SQLOLEDB.1;" & _ "P******D=**********;" & _ "PERSIST SECURITY INFO=True;" & _ "USER ID=**********;" & _ "INITIAL CATALOG=**********;" & _ "DATA SOURCE=******;" & _ "USE PROCEDURE FOR PREPARE=1;" & _ "AUTO TRANSLATE=True;" & _ "CONNECT TIMEOUT=0;" & _ "COMMAND TIMEMOUT=0" & _ "PACKET SIZE=4096;" & _ "USE ENCRYPTION FOR DATA=False;" & _ "TAG WITH COLUMN COLLATION WHEN POSSIBLE=False" Sub Import_Using_ADO() Dim rs As Object Dim cn As Object '===================== 'get in touch with the server Set cn = CreateObject("ADODB.Connection") cn.Open strC cn.CommandTimeout = 0 Set rs = CreateObject("ADODB.Recordset") Set rs.ActiveConnection = cn With rs 'Extract and copy the required records .Open "SELECT myColName" & _ " FROM Wdatabase.dbo.myTableName" With Excel.ThisWorkbook.Sheets(mySheetName) .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1).CopyFromRecordset rs End With .Close 'close connection End With '===================== 'tidy up On Error Resume Next cn.Close Set cn = Nothing Set rs = Nothing Set rs.ActiveConnection = Nothing '===================== End Sub