Question

我正在开发一个vbscript，我需要将一些值从SQL Server DB的特定表的特定列导入到MS Excel。我对此没有任何线索。

请您告诉我如何实现上述情况。

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中。

Answer 1

这是一个使用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

VBScript将SQL Server数据库的特定列导入excel

1 个答案: