Server Side Automation of Excel, security issues.

[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