Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sever side excel automation issue
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sever side excel automation issue
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" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sever side excel automation issue
"Barb Reinhardt" wrote:
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. HTH, Barb Reinhardt "djcohen66" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
programming issue when using Excel automation | Excel Programming | |||
Excel date fields to MS SQL Sever via OLE | Excel Programming | |||
Excel Automation : numbers Copy/Paste issue from VB6 | Excel Programming | |||
Excel Automation Issue | Excel Programming |