Sever side excel automation issue

[djcohen66]

I have an older windows service program written in VB6 that uses CreateObject
to automate the excel application object and do the following:

~ Read a csv file
~ Open the installed Excel application on a server
~ Load a workbook that is used like a template.
~ Copy data from the csv file into a target data sheet in the template
workbook.
~ Run a named macro on the data loaded template
~ Save the data loaded and transformed file as a new file

All of this works great with Office 2003 up to service pack 2. I have to
register my service so that it runs under a specific user account, but
otherwise there are no issues. However once I upgrade to Excel 2003 sp3 or
greater, not to mention 2007, the create object call no longer works. I
cannot create the application object unless VBA is disabled, and if VBA is
disabled, I cannot run the transformational macros.

I am assuming that it is a security setup issue that is stopping my code
from working properly. If anyone can shed some light on how to get around
this problem I would be most greatful.

Here is my vb code:

Private Function CSVToExcel(a_strPlanName As String, a_strRepository As
String, a_intBatchID As Long, a_strPath As String, ByRef a_strError As
String) As Boolean
'////////////////////////////////////////////////////////////
'// Purpose:
'// Gather data from a delimited text file, dump it into
'// An excel template and save the results.
'////////////////////////////////////////////////////////////
'// Created 5/24/2006 by David Cohen for MedInitiatives
'////////////////////////////////////////////////////////////
'// Modified 9/14/2006 by david cohen - Added code to determine the exact
amount of data in the data sheet. Rather than using
'// the DataRangeEnd value to approximate.
'////////////////////////////////////////////////////////////
On Error GoTo Catch

Dim l_rs As Recordset
Dim oExcel As Object
Dim oTemplate As Object
Dim oData As Object
Dim oDataSheet As Object
Dim oTemplateSheet As Object
Dim mystream As ADODB.Stream
Dim l_FSO As FileSystemObject
Dim retval As Variant
Dim l_strErr As String
Dim l_strPlanName As String
Dim l_strDebug As TextStream
Dim l_intErr As Integer
Dim lastrow As Integer
Dim lastcol As Integer
Dim l_strData As TextStream
Dim l_lngDataLineCount As Long

'// Set the file system object
Set l_FSO = New FileSystemObject
Set l_strDebug = l_FSO.OpenTextFile("C:\Batch\CSVToExcelDebug.txt",
ForAppending, True)

l_intErr = 1
l_strDebug.WriteLine l_intErr & ": Processing Batch ID: " & a_intBatchID &
". Create and Set the type of the ADO Stream."
'// Create a new stream object to retrieve the excel template
Set mystream = New ADODB.Stream
mystream.Type = adTypeBinary
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 2
l_strDebug.WriteLine l_intErr & ": Set the recordset and select the template
row."
'// Get the template and data associated with this excel file
Set l_rs = New ADODB.Recordset
l_rs.Open "Select * from is_ExcelTemplate where PlanName = '" &
a_strPlanName & "'", m_connSys, adOpenStatic, adLockOptimistic
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 3
'// Stream the file to the temp area
l_strDebug.WriteLine l_intErr & ": Open the stream and get the template."
mystream.Open

If Not l_rs!CSVExportFlag Then
If Not IsNull(l_rs!Template) Then
mystream.Write l_rs!Template
Else
'// If this process fails we have a problem.
CSVToExcel = False
l_strErr = "No Excel Template Data passed."
GoTo Catch
End If
End If
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 4
l_strDebug.WriteLine l_intErr & ": Remove any unacceptable characters from
the filename and save the template."
'// Remove any unacceptable characters from the filename
l_strPlanName = Replace(a_strPlanName, "*", "_")
l_strPlanName = Replace(l_strPlanName, "/", "_")
l_strPlanName = Replace(l_strPlanName, "\", "_")
l_strPlanName = Replace(l_strPlanName, "|", "_")
l_strPlanName = Replace(l_strPlanName, "<", "_")
l_strPlanName = Replace(l_strPlanName, ">", "_")
l_strPlanName = Replace(l_strPlanName, ":", "_")

'// Save the template
On Error Resume Next
mystream.SaveToFile a_strPath & "\" & l_strPlanName & ".xls",
adSaveCreateOverWrite
If Err.Number = 3004 Then
If l_FSO.FileExists(a_strPath & "\" & l_strPlanName & ".xls") Then
l_strDebug.WriteLine l_intErr & ": Error reported but file exists.
Disregarding error."
Else
GoTo Catch
End If
End If
On Error GoTo Catch
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 5
l_strDebug.WriteLine l_intErr & ": Open the excel application object."
'// Open Excel
On Error GoTo NoExcel
Set oExcel = CreateObject("Excel.Application")
On Error GoTo Catch
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 6
l_strDebug.WriteLine l_intErr & ": Setting options on excel application
object."
oExcel.AlertBeforeOverwriting = False
oExcel.AskToUpdateLinks = False
oExcel.DisplayAlerts = False
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 7
l_strDebug.WriteLine l_intErr & ": Open the csv in memory. Count the rows."

'// Find out how many rows are in the data file
Set l_strData = l_FSO.OpenTextFile(a_strPath & "\" & a_intBatchID & ".csv",
ForReading, False)

Do Until l_strData.AtEndOfStream
l_strData.SkipLine
Loop
l_lngDataLineCount = l_strData.line
l_strData.Close
If l_lngDataLineCount = 0 Then l_lngDataLineCount = 1
If l_lngDataLineCount > 65536 Then
l_lngDataLineCount = 65530
l_strDebug.WriteLine l_intErr & ": Too much data, " & l_lngDataLineCount
& " rows returned. Too much to put in excel. Data Truncated at 65,530 rows."
Else
l_strDebug.WriteLine l_intErr & ": Successful, less than 65,536 rows."
End If
l_intErr = 8
l_strDebug.WriteLine l_intErr & ": Open the template and csv in excel."

'// Open the template
Set oTemplate = oExcel.Workbooks.Open(a_strPath & "\" & l_strPlanName &
".xls")

'// Open the data csv
Set oData = oExcel.Workbooks.Open(a_strPath & "\" & a_intBatchID & ".csv")
l_strDebug.WriteLine l_intErr & ": Successful"


l_intErr = 9
l_strDebug.WriteLine l_intErr & ": Get the data sheet into a variable."
'// Get the sheets we need
l_strDebug.WriteLine l_intErr & ": Trying to get data sheet " & a_intBatchID
& " into a data variable."
Set oDataSheet = oData.Worksheets(CStr(a_intBatchID))
l_strDebug.WriteLine l_intErr & ": Trying to get template data sheet " &
l_rs!DataSheetName & " into a variable."
Set oTemplateSheet = oTemplate.Worksheets(CStr(l_rs!DataSheetName))
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 10
l_strDebug.WriteLine l_intErr & ": Copy the data into the template."
'// Copy the data into the template
oDataSheet.Activate

oDataSheet.Range("A1", CStr(l_rs!DataRangeEnd & l_lngDataLineCount)).Copy
oTemplateSheet.Range(CStr(l_rs!TargetDataStart))
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 11
l_strDebug.WriteLine l_intErr & ": Save Results to a new File."
'// Save the results
oTemplate.SaveCopyAs a_strPath & "\" & a_intBatchID & ".xls"
oData.Close SaveChanges:=False
oTemplate.Close SaveChanges:=False
Set oTemplate = Nothing
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 12
l_strDebug.WriteLine l_intErr & ": Open new file and run macros if there are
any."
'// Reopen the file and run any macros
If Not IsNull(l_rs!MacroName) Then
If Not Len(l_rs!MacroName) = 0 Then
Set oTemplate = oExcel.Workbooks.Open(CStr(a_strPath & "\" &
a_intBatchID & ".xls"))
l_strErr = "Attempting to run macro, " & l_rs!MacroName & "."
retval = oTemplate.Application.Run(CStr(l_rs!MacroName))
If retval = 0 Then
l_strErr = "Error running macro '" & l_rs!MacroName & "' in
template '" & a_strPlanName & "'."
GoTo Catch
End If
oTemplate.Close SaveChanges:=True
End If
End If
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 13
l_strDebug.WriteLine l_intErr & ": Clean up objects."
Set oData = Nothing
Set oTemplate = Nothing
Set oExcel = Nothing
Set oDataSheet = Nothing
Set oTemplateSheet = Nothing
l_strDebug.WriteLine l_intErr & ": Successful."

l_intErr = 14
l_strDebug.WriteLine l_intErr & ": Delete work files."
'// Delete the template
Call l_FSO.DeleteFile(a_strPath & "\" & a_strPlanName & ".xls")
'// Delete the data file
Call l_FSO.DeleteFile(a_strPath & "\" & a_intBatchID & ".csv")
l_strDebug.WriteLine l_intErr & ": Successful."
l_strDebug.Close
Set l_strDebug = Nothing
Set l_FSO = Nothing
CSVToExcel = True

Exit Function
NoExcel:
l_strErr = "Excel Application object could not be created! Excel Not
Installed!"
Catch:
l_strDebug.WriteLine "Line: " & l_intErr & " - Error. " & Err.Number & "
- " & Err.Description
l_strDebug.Close
If l_lngDataLineCount > 65000 Then
a_strError = "Error: Rowcount exceeded 65000."
Else
a_strError = l_intErr & " - Error. " & Err.Number & " - " &
Err.Description
End If
Set l_strDebug = Nothing
If l_FSO.FileExists(a_strPath & "\" & a_strPlanName & ".xls") Then
'// Delete the template
Set oTemplateSheet = Nothing
Call l_FSO.DeleteFile(a_strPath & "\" & a_strPlanName & ".xls")
End If
'// Delete the data file
If l_FSO.FileExists(a_strPath & "\" & a_intBatchID & ".csv") Then
Call l_FSO.DeleteFile(a_strPath & "\" & a_intBatchID & ".csv")
End If
'// Delete the failed output file
If l_FSO.FileExists(a_strPath & "\" & a_intBatchID & ".xls") Then
Call l_FSO.DeleteFile(a_strPath & "\" & a_intBatchID & ".xls")
End If
CSVToExcel = False
Set oData = Nothing
Set oTemplate = Nothing
Set oExcel = Nothing
Set oDataSheet = Nothing
Set oTemplateSheet = Nothing
Set l_FSO = Nothing
End Function

 

[Barb Reinhardt]

IIRC, I had issues with CreateObject on machines with Excel 2007 when it
created an Excel 2003 object. I had to have Excel 2007 open before I ran
the code. Since it was going to be obsolete within a month, I didn't bother
to figure out a fix. I did use GetObject (I think) to find an open Excel
object first.

As an aside, might you have attended Juniata.

HTH,
Barb Reinhardt

 

[djcohen66]

IIRC, I had issues with CreateObject on machines with Excel 2007 when it
created an Excel 2003 object. I had to have Excel 2007 open before I ran
the code. Since it was going to be obsolete within a month, I didn't bother
to figure out a fix. I did use GetObject (I think) to find an open Excel
object first.

All the template objects (300+) have been created with 2003, the macros are
different and specific for each of the reports they are meant to generate.
The application that creates excel is an unattended service (yes I know MS
does not reccomend or support this) so there is no open instance of excel.
My concern is being able to update servers with the most recent versions of
Excel and still run the service application.

As an aside, might you have attended Juniata.

I did not, sorry.