Creating Excel Sheet from ActiveX
-
Hi,
I am using below ActiveX script to create an excel sheet and then insert some text in cell.
'**********************************************************************
' Visual Basic ActiveX Script
'************************************************************************
Function Main()
Dim sAuditFileName
Dim sErrorFolderName
Dim sLogFileName
Dim ExcelSheet
sAuditFileName = DTSGlobalVariables("gsAuditFilePath").Value & "\Audit_" & DTSGlobalVariables("gsDateTimeString").Value & ".xls"
'Get the Error Folder Name
sErrorFolderName=DTSGlobalVariables("gcErrorFolderName").Value
sLogFileName = DTSGlobalVariables("gsLogFilePath").Value & "\" & sErrorFolderName & ".log"
DTSGlobalVariables("gsLogFileName").Value = sLogFileName
Msgbox 1
' Declare an object variable to hold the object
Set ExcelSheet = CreateObject("Excel.Sheet")
Msgbox 2
' Place some text in the first cell of the sheet.
ExcelSheet.Application.Cells(1, 1).Value = "TEST"
Msgbox 3
' Save the sheet as sAuditFileName.
ExcelSheet.SaveAs sAuditFileName
' Close Excel with the Quit method on the Application object.
ExcelSheet.Application.Quit
' Release the object variable.
Set ExcelSheet = Nothing
Main = DTSTaskExecResult_Success
End Function
*************************************************
This script was running fine but all of sudden it started failing with below error:
'ActiveX Scripting encountered a Run Time Error during the execution of the script.'
On further analysis I figured out that it is not able to create the object somehow (as I am getting the message 1 but not 2) . Also all the global variables are returning correct values. There seems to be some settings/permissions issue.
Any information in this regard will be helpful.
Thanks in advance
Prashant
-
One way I use ActiveX is for outputting an excel file based on a view and a recordset within the ActiveX
By the way, you need create and Excel Application object not a Sheet object. in your own code.
Here's an example of the code I use
Dim strFileLocation, strSwopFileLocation
strFileLocation = "\\some_server\shared\somefile.xls"
Function Main()
deleteExcelFile(strFileLocation)
createExcelFile()
Main = DTSTaskExecResult_Success
End Function
Sub deleteExcelFile(srtFileLocation)
Dim fso, ExcelFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set excelFile = fso.GetFile(strFileLocation)
excelFile.Delete
End Sub
Function createExcelFile ()
Dim objExcel, objWorkBook, objWorkSheet
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkBook = objExcel.Workbooks.Add
Dim objConn, objRS, strConn, strSQL
Set objConn = CreateObject("ADODB.Connection")
Set objRS = CreateObject("ADODB.RecordSet")
strSQL = "select * from myServer.dbo.myView"
strConn = "DSN=myDSN;Database=myDB;uid=myUID;pwd=myPWD"
objConn.Open(strConn)
Set objRS= objConn.Execute(strSQL)
Dim strColumnCountOffset, strRowCountOffset
strColumnCountOffset = 1
strRowCountOffset = 1
For Each objField In objRS.Fields
objWorkBook.Worksheets(1).Cells(strRowCountOffset, strColumnCountOffset).Font.Name = "Verdana"
objWorkBook.Worksheets(1).Cells(strRowCountOffset, strColumnCountOffset).Font.Size = 8
objWorkBook.Worksheets(1).Cells(strRowCountOffset, strColumnCountOffset).Font.Bold = true
objWorkBook.Worksheets(1).Cells(strRowCountOffset, strColumnCountOffset).Value= objField.Name
objWorkBook.Worksheets(1).Cells(strRowCountOffset, strColumnCountOffset).Font.Color = RGB(0,0,0)
strColumnCountOffset = strColumnCountOffset + 1
' No need to do this for rowcount as it is only the first ropw that we want the headings
Next
' Resest the offsets to row 2 column 1
strColumnCountOffset = 1
strRowCountOffset = 2
For Each objField In objRS.Fields
strRowCountOffset = 2
objRS.MoveFirst ' Need to requery as the recordset is at EOF from last iteration
While not objRS.EOF and not objRS.BOF
objWorkBook.Worksheets(1).Cells(strRowCountOffset, strColumnCountOffset).Font.Name = "Verdana"
objWorkBook.Worksheets(1).Cells(strRowCountOffset, strColumnCountOffset).Font.Size = 8
objWorkBook.Worksheets(1).Cells(strRowCountOffset, strColumnCountOffset).Value= objRS.Fields(objField.Name)
objWorkBook.Worksheets(1).Cells(strRowCountOffset, strColumnCountOffset).Font.Color = RGB(0,0,0)
strRowCountOffset = strRowCountOffset + 1
objRS.MoveNext
Wend
strColumnCountOffset = strColumnCountOffset + 1
Next
objWorkBook.SaveAs (strFileLocation)
objWorkBook.Close True
Set objWorkBook = Nothing
Set objExcel = Nothing
End Function
-
Thanks John,
This piece of code was really helpful. I created Excel.Application instead of Excel Sheet object.
Kind Regards
Prashant
Viewing 3 posts - 1 through 2 (of 2 total)
You must be logged in to reply to this topic. Login to reply