Excel crashes when same report is run again

[carrie09]

Hi,

I have a form that is used to run a report in excel using a template based on user selections. So there is a VB code and a macro that is used to update the file with query output.
My problem is that when the user makes a selection and runs this report, it runs fine and creates an excel sheet called "customerpricing.xls".
Now if the user tries to run the same report by chosing something else from the form without closing this already created report, then it crashes excel.

So I have to include a code somewhere in the existing code that checks on user machine if "customerpricing.xls" is already open. If its open, then it gives a message to user to close the report. Once user closes the report, he can run the report again.

Or the other option is if the code checks for this file. If its open, then it runs the report but creates file with name "customerpricing_1.xls" and so it just adds _1, _2, _3...and so on to the file name.

Or if there is anyway to stop this from happening by tweaking the code.

I'm attaching the file that contains the code and macro.
Can someone please advise what the best option is and how to make this work?

 

[Guus2005]

difficult to avoid. you can work around it by first creating the file and then opening it in Excel. Next time you check for the file and give the new file the next available number

 

[carrie09]

I'm sorry Guus but I'm a beginner and am unable to make changes to this code correctly. I'm thinking the code as well as macro will have to be changed.

So I guess it will be easier to just include the first option about giving users a message if file is open and run the code once they close it.

So the logic should be, check if file with name "customerpricing.xls" is open anywhere on user's system.
If it is open, then give a message that file is open and exit out of the function.
If its not open, then run the code.

 

[carrie09]

Can someone please help me and tweak my code accordingly?

 

[RoyVidar]

You are doing several "no-nos" here.

One is implicit instantiation of Excel through Dim xl as new excel application, should be

Dim xl as Excel.Application
set xl = New Excel.Application

or instantiate through CreateObject

Dim xl as Excel.Application
set xl = CreateObject("Excel.Application")

Then, several places, you're using implicit references to Excel methods, properties and objects. This will most probably create an extra instance of Excel in memory (check Task Manager), and cause unwanted behaviour.

Some samples:

Application.DisplayAlerts = False
should be
xl.Application.DisplayAlerts = False

Selection.End(xlToRight).Select
should be
xl.Selection.End(xlToRight).Select

The Range method needs to be anchored to a relevant Excel object (sheet object?), likewise Rows, Active<whatever>...

See http://support.microsoft.com/default.aspx?kbid=178510 for more info.

Until these things are fixed, you will have unanticipated results, behaviour etc. Most likely, the main problem will "go away" when this is fixed, or just give some "file in use" message.

You could also use a GetObject/CreateObject combination to instantiate Excel.

I'm not sure, but it looks like you're both opening Excel through some DoCmd thingie and Automation at the same time. I don't know if that hurts, but I do know that if you open the same file through more than one method at the time, it will create "amusement".

 

[carrie09]

Thanks a lot for your reply Roy. I made changes as per your suggestion and the article you mentioned. However I'm still having trouble running this report again.
Will you be able to make changes to my code file so that I can be sure that I'm making correct changes?
If thats not possible, then can you please advise me the code for the message box option? I can include a code that checks user's computer to see if "customerpricing.xls" is open. If it is, then give user a message to close the file and try again and exits out of code. If there is no such file open, then it directly runs the code.

 

[RoyVidar]

I'm not going to write your program, that you'll have to do yourself

But post your current code, be a bit explicit about what it does, what it doesn't, what happens, what should happen..., and someone will probably have a go at it.

Do post the code within the thread, please, and inside [ code ] tags (the # button in the reply pane)

By a smallish web search, I found some attempts to check whether a file is alredy open
http://www.vbaexpress.com/kb/getarticle.php?kb_id=468
which is more or less the same as
http://support.microsoft.com/kb/213383
http://www.exceltip.com/st/Determin...dy_open_using_VBA_in_Microsoft_Excel/472.html

 

[carrie09]

I tried to make changes to my code using the reference links you gave but its not working correctly. Below is the code. What is does is:
1. Open a reference template template ".XLT" from a particular location.
2. Run the query and output its result to this template and call it "customerpricing.xls".
3. Now run the code in a macro that contains some VB code.

Now in this code I need to include some code that checks if there is any file named "customerpricing.xls" already open in user's system before running the query that outputs result to this xls.
If there is any such file open, then give a message about file being open and then exit function.
If there is no such file open, then continue with the function.

So there should be some code included before the line that outputs query to xls.

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

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
 End If
 

Dim xl As Excel.Application
Set xl = New Excel.Application
xl.Workbooks.Open e_TemplateFile & "crm proposal input.XLT"

 
   
            [B]DoCmd.OutputTo acOutputQuery, "CustPricingbyRMCrosstabquery", acFormatXLS, "c:\customerpricing.xls", True[/B]
   
        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 - NEWLY COMMENTED OUT
        Set fs = Nothing
        
        DoCmd.CLOSE acForm, "rmpricingdataform"
        Call AuditTrail("RM Pricing report", "Execute")
        


 End Function

Any help is greatly appreciated.

 

[Guus2005]

Some feedback on your code:

Dim ans, Msg as string

I believe that your intention is to create two strings. You have created a variant (ans) and a string (Msg)
Remove "On Error Resume Next" and use it only if you are aware what your program is doing and what kind of error is created which you are not interested in.
Group all your variable dimensions at the beginning of your function. The way you are doing it is confusing.
Statement Call is not necessary anymore since Acces 2.0
Compile your code and run it. If it previously crashes, it now should give you an idea where the first error occures.

Enjoy!

 

[carrie09]

Hi Guus,
Thanks for ur suggestion. U r right. I wanted 2 strings...so I corrected that and also grouped all my variables in beginning.
However I'm still stuck with the initial problem. The code works fine without errors. The only problem is that if its run again without closing the sheet created, it crashes excel. So I want to include a code that checks if this file is already open on user's system and if it is thn give a message to close it. If its not then run the code.
So I need help in including that code within my existing code.
Can u pls help??

 

[Guus2005]

Please post the corrected code and i'll have a look.

 

[carrie09]

Here u go Guus...

This is the code thats working correctly. Only thing I need to modify is the file open condition I mentioned previously.

Public Function getrmpricing()
Dim queryoption As String
Dim Msg As String
Dim fs As Object
Dim sTemplateFile As String
Dim e_TemplateFile As String
Dim xl As Excel.Application
Set xl = New Excel.Application

     
    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
 End If
 

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 - NEWLY COMMENTED OUT
        Set fs = Nothing
        
        DoCmd.CLOSE acForm, "rmpricingdataform"
     
 End Function

 

[gblack]

Kill Excel

OK I think I had a similar issue a while back... I got this code off the internet. It kills excel on contact. Don't ask me how it works. I didn't write it. Someone named Andrew Baker wrote it and I thank him everytime I run that report.

I was having issues with an instance of excel not closing. This will kill it! Throw this in when you need excel to die die die die! "It's the only way to be sure"

hth
Gary

--------------------------------------------------------------------------

Option Explicit
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Type LUID
LowPart As Long
HighPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type


Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Purpose : Terminates a process given a process ID or a the handle to a form.
'Inputs : [lProcessID] The process ID (or PID) to terminate.
' [lHwndWindow] Any window handle belonging to the application.
'Outputs : Returns True on success.
'Author : Andrew Baker
'Date : 28/04/2001
'Notes : In WIN NT, click the "Processes" tab in the "Task Manager"
' to see the process ID (or PID) for an application.
' Must specify either lHwndWindow or lProcessID.
' Equivalent to pressing Alt+Ctrl+Del then "End Task"

Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean
Dim lhwndProcess As Long
Dim lExitCode As Long
Dim lRetVal As Long
Dim lhThisProc As Long
Dim lhTokenHandle As Long
Dim tLuid As LUID
Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long

Const PROCESS_ALL_ACCESS = &H1F0FFF, PROCESS_TERMINATE = &H1
Const ANYSIZE_ARRAY = 1, TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8, SE_DEBUG_NAME As String = "SeDebugPrivilege"
Const SE_PRIVILEGE_ENABLED = &H2

On Error Resume Next
If lHwndWindow Then
'Get the process ID from the window handle
lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
End If

If lProcessID Then
'Give Kill permissions to this process
lhThisProc = GetCurrentProcess

OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid
'Set the number of privileges to be change
tTokenPriv.PrivilegeCount = 1
tTokenPriv.TheLuid = tLuid
tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
'Enable the kill privilege in the access token of this process
AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded

'Open the process to kill
lhwndProcess = OpenProcess(PROCESS_TERMINATE, 0, lProcessID)

If lhwndProcess Then
'Obtained process handle, kill the process
ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
Call CloseHandle(lhwndProcess)
End If
End If
On Error GoTo 0
End Function
-------------------------------------------------------------------------------------------------------------
Dim xlapp As New Excel.Application
Dim lHwnd As Long...


'Kill Excel with these two lines and the Function above
lHwnd = FindWindow("XLMAIN", xlapp.Caption)
ProcessTerminate , lHwnd

 

[Guus2005]

?

What are you trying to Activate? You haven't opened anything? Your code doesn't make any sense.

I don't know what you are trying to do.

Sorry, can't help you here.

 

[carrie09]

Thanks Gblack..this does seem like a good piece of code.

Guus, this code refers to a macro in excel that basically generates the complete file but i haven't included it here as nothing needs to be changed in that.

The only requirement is to include a code within the code i pasted towards the beginning that checks for a file being already open and if it is thn give a message and stop the code execution.
And if its not then continue with code execution.
Can you help?

 

[Guus2005]

When a spreadsheet was already openened by someone else, your copy is readonly until the other person closes theirs. Illustrated by this example

Public Sub OpenSpreadsheet()

    Dim strFilename As String
    Dim appExcel    As Excel.Application
    Dim wbExcel     As Workbook
    Dim wsExcel     As Worksheet
    
    strFilename = InputBox("Enter path to spreadsheet", "Open spreadsheet")
 
    Set appExcel = New Excel.Application
    Set wbExcel = appExcel.Workbooks.Open(strFilename)

    If wbExcel.ReadOnly Then
        MsgBox "Your spreadsheet was already open.", vbExclamation
        wbExcel.Close
        Set appExcel = Nothing
    End If

End Sub

HTH

Enjoy!