Hi,
I have a code that creates an excel report from a template file and query output.
System was freezing if user runs this reports again without closing the previously created file. So I included a code that checks if a file "customerpricing.xls" is already open on user's system and if it is then it gives user a message and stops running the report. However if there is no such file open then it runs fine and creates the report.
The problem I'm having after including the code(included in asterisks ****) is that if there is a file with same name open, then it gives the error message and user can go ahead and close the file. However it doesn't kill the excel instance in task manager for some reason.
Can someone please advise whats wrong with this code?
Public Function getrmpricing()
Dim queryoption As String
Dim ans, Msg As String
Dim fs As Object
Dim sTemplateFile As String
Dim e_TemplateFile As String
*****Dim oWB As Excel.Workbook
For Each oWB In Excel.Workbooks
If oWB.Name = "customerpricing.xls" Then
MsgBox "Your spreadsheet was already open. Please close the file and run the report again.", _
vbCritical, "WARNING"
On Error Resume Next
DoCmd.CLOSE acForm, "rmpricingdataform"
GoTo Errortrap
Exit For
End If
Next
Set oWB = Nothing ******
On Error Resume Next
sTemplateFile = g_dashboard & "crm proposal input.XLT"
e_TemplateFile = "C:\"
If Forms!rmpricingdataform!BU = "CS" Then
MsgBox "No template available for CS!", vbOKOnly, "RM Pricing Report"
Else
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile sTemplateFile, e_TemplateFile, True
Dim xl As Excel.Application
Set xl = New Excel.Application
xl.Workbooks.Open e_TemplateFile & "crm proposal input.XLT"
DoCmd.OutputTo acOutputQuery, "CustPricingbyRMCrosstabquery", acFormatXLS, "c:\customerpricing.xls", True
Dim xs As Excel.Application
Set xs = New Excel.Application
xs.Workbooks("customerpricing").Activate
xs.ActiveWorkbook.Activate
Select Case Forms!rmpricingdataform!BU
Case "CRM"
xl.Run "'crm proposal input.XLT'!CRM_CAPSPriceTemplate.CRM_CAPSPriceTemplate"
End Select
'xs.Workbooks.CLOSE - NEWLY COMMENTED OUT
xl.Workbooks("crm proposal input.XLT").CLOSE
'xl.Workbooks("crmpricing.xls").Save - NEVER USED
fs.deletefile e_TemplateFile & "crm proposal input.XLT", True
Set fs = Nothing
DoCmd.CLOSE acForm, "rmpricingdataform"
Call AuditTrail("RM Pricing report", "Execute")
End If
Errortrap:
End Function
I have a code that creates an excel report from a template file and query output.
System was freezing if user runs this reports again without closing the previously created file. So I included a code that checks if a file "customerpricing.xls" is already open on user's system and if it is then it gives user a message and stops running the report. However if there is no such file open then it runs fine and creates the report.
The problem I'm having after including the code(included in asterisks ****) is that if there is a file with same name open, then it gives the error message and user can go ahead and close the file. However it doesn't kill the excel instance in task manager for some reason.
Can someone please advise whats wrong with this code?
Public Function getrmpricing()
Dim queryoption As String
Dim ans, Msg As String
Dim fs As Object
Dim sTemplateFile As String
Dim e_TemplateFile As String
*****Dim oWB As Excel.Workbook
For Each oWB In Excel.Workbooks
If oWB.Name = "customerpricing.xls" Then
MsgBox "Your spreadsheet was already open. Please close the file and run the report again.", _
vbCritical, "WARNING"
On Error Resume Next
DoCmd.CLOSE acForm, "rmpricingdataform"
GoTo Errortrap
Exit For
End If
Next
Set oWB = Nothing ******
On Error Resume Next
sTemplateFile = g_dashboard & "crm proposal input.XLT"
e_TemplateFile = "C:\"
If Forms!rmpricingdataform!BU = "CS" Then
MsgBox "No template available for CS!", vbOKOnly, "RM Pricing Report"
Else
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile sTemplateFile, e_TemplateFile, True
Dim xl As Excel.Application
Set xl = New Excel.Application
xl.Workbooks.Open e_TemplateFile & "crm proposal input.XLT"
DoCmd.OutputTo acOutputQuery, "CustPricingbyRMCrosstabquery", acFormatXLS, "c:\customerpricing.xls", True
Dim xs As Excel.Application
Set xs = New Excel.Application
xs.Workbooks("customerpricing").Activate
xs.ActiveWorkbook.Activate
Select Case Forms!rmpricingdataform!BU
Case "CRM"
xl.Run "'crm proposal input.XLT'!CRM_CAPSPriceTemplate.CRM_CAPSPriceTemplate"
End Select
'xs.Workbooks.CLOSE - NEWLY COMMENTED OUT
xl.Workbooks("crm proposal input.XLT").CLOSE
'xl.Workbooks("crmpricing.xls").Save - NEVER USED
fs.deletefile e_TemplateFile & "crm proposal input.XLT", True
Set fs = Nothing
DoCmd.CLOSE acForm, "rmpricingdataform"
Call AuditTrail("RM Pricing report", "Execute")
End If
Errortrap:
End Function