VBScript to import specific column of SQL Server database to excel - sql

Question

I am developing a vbscript in which i need to import some values from particular column of specific table of SQL Server DB to MS Excel. I dont have any clue about this.
Could you please suggest me the way in which i can achieve the above scenario.
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
In above code i want to retrieve value of SSDICOMApplicationEntityID from DATABASE and want to put in Excel. Currently i am manually inserting it in Excel.

Answer 1

This is a simple example of moving data the other way using VBA you'll need to do some conversion but I'm guessing not too much:
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