Various times i have seen people looking for the resources to have the very basic functionality using Sql Server 2000 DTS (Data transformation services). So i thought to consolidate the basic needs and to write a useful code for the beginers .
The following code does the following
1. Connects to the Sql server
2. Executes Stored procedure with parameters
3. Manipulate Excel file
4. Send Email by attaching the excel file
You have to write the following code to DTS package's ActiveX Script task
'**********************************************************************
' Visual Basic ActiveX Script
'************************************************************************
Function Main()
'************************************Opening Connection*******************************************
dim objCN
dim objCMD
dim objRS
set objCN = CreateObject("ADODB.Connection")
set objCMD = CreateObject("ADODB.Command")
objCN.open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=DbName;Packet Size=4096;DataSource=local"
objCMD.ActiveConnection = objCN
'*********************************Executing Stored Procedure****************************
objCMD.CommandText = ""
objCMD.CommandType = 4 'adCmdStoredProc
objCMD.Parameters.Append objCMD.CreateParameter("",200,1,255,)
objCMD.Parameters.Append objCMD.CreateParameter("",200,1,255,)
Set objRS = objCMD.Execute
'*******************************Creating the excel file ******************************************
Dim appExcel
Dim newBook
Dim oSheet
Dim oPackage
Dim oConn
Dim intRow
Set appExcel = CreateObject("Excel.Application")
Set newBook = appExcel.Workbooks.Add
'Specify the column name in the Excel worksheet
appExcel.Cells(1, 1).Value = "Date"
appExcel.Cells(1, 2).Value = "Name"
appExcel.Cells(1, 3).Value = "Phone"
appExcel.Cells(1, 4).Value = "Mailing Address"
appExcel.Cells(1, 5).Value = "Message"
Set objRange = appExcel.Range("A1","E1")
objRange.Font.Size = 12
intRow = 2
do while not objRS.eof
appExcel.Cells(intRow, 1).Value = objRS.Fields("DateCreated").value
appExcel.Cells(intRow, 2).Value = objRS.Fields("Name").value
appExcel.Cells(intRow, 3).Value = objRS.Fields("Phone").value
appExcel.Cells(intRow, 4).Value = objRS.Fields("MailingAddress").value
appExcel.Cells(intRow, 5).Value = objRS.Fields("Message").value
intRow = intRow + 1
objRS.movenext
loop
With newBook
.SaveAs "C:\ContactDeatils.xls"
.save
End With
Dim oMail
Set oMail = CreateObject("CDO.Message")
oMail.From ="abc@abc.com"
oMail.To = "support@talentcertification.com"
oMail.Cc = "testing@yahoo.com"
oMail.Subject = "Contact Details"
oMail.TextBody = "Please find the enclosed report."
oMail.AddAttachment ("C:\ContactDeatils.xls")
oMail.Send
Set oMail = Nothing
Main = DTSTaskExecResult_Success
End Function
|