Access/Excel interaction...excel.exe problem

Ian Mac · Aug 29, 2002

All,

I'm trying to run reports from Access which load an Excel.xlt and places values into a worksheet,
then creates a chart and dynamically set the SourceData.

The problem I'm getting (and this is a recurring problem for a number of people where I work) is that when trying to run the same report (sometimes even a different one) a second time the SourceData line throw up an error message.

Now here's where I get confusing, so please bare with me.

I THINK I've discovered the cause of the problem but don't know how to fix it.
at the start of the code are the lines:

Set xlapp = CreateObject("Excel.Application")
Set xlBook = xlapp.Workbooks.Add("downloadProgressReport.xlt ")
Set xlSheet = xlBook.Worksheets(1)

this creates a version of Excel.
The problem when running the report a second time is that even when the first one is closed down, excel.exe is still in memory.

My thoughts on this are:

1) How can I tell Access remove the link to that excel.exe and focus on the newly created object?
I think Access is getting confused halfway through the code.
(Another question is what in the code might cause this to happen?)

or

2) How do I get rid of the other version of Excel when I close it (remove it from memory)

or

3) Check to see if Excel is currently running then use that if it is, if not CreateObject
(this may cause a problem as .xlt is not always used, sometimes the template is saved as
.xls therefore it will display an alert when it tries to load another version, unlike .xlt which will name it Report1, Report2 etc.)

or

4) I seem to remember seeing a way to loading the sheet using the CreateObject command.

Of course I may well be off track, so if anyone can help with these OR has any different ideas, I'd luv em thanks.

If I can get this licked, I will be putting on my Cape and Mask and walking right up to Mr. I.T. Person shouting, "I've come to ave the day."

Many thanks,

_________________
Share the wealth!!
Ian Mac
This message was edited by Ian Mac on 2002-08-29 05:56

Ivan F Moala · Aug 31, 2002

Hi Ian
Hope you don't mind, just a little COMS 101...

As Dennis, dmckinney & KniteMare have pointed out, you need to set
the used variables to nothing:

eg.

Set xlSheet = Nothing
Set xlBook = Nothing
set xlapp = Nothing

This is Std procedure when working with automation (OLE for some!)
Normally the automation object variable is destroyed when it loses
scope, reinitialized or is explicitly destroyed.

To explicitly destroy an Automation object variable, set it to the
keyword "Nothing" as Everyone has suggested.

Note that with some Automation Servers (The Automation Server is
the application that exposes the automation object = Excel), setting
an object variable to Nothing doesn’t necessarily close the server
application. If you're using the CreateObject function to create an
instance of an Automation Server, be sure to use a method defined
by the Server [Excel] to quit it if possible and then set the object
variable to "Nothing". If not, your code may be leaving multiple
sessions of the Automation server open.
This is very common when automating Microsoft Excel & Word, for
instance.

To close the application, use the "Quit" method prior to setting the
object variable out of scope.

As Lillianne has suggested.

xlapp.Application.Quit

So When using COMS basic steps should be
(For Early and late Binding - of which you are using Late)

1) Set Object Variable [ALL]
eg. Set xlApp = CreateObject("Excel.Application")
or [GetObject Function]

2) Quit the application object using proper Method
eg. xlApp.Quit (Thanks Lillianne)

3) Then destroy the object [ALL]
eg. Set xlApp = Nothing

Not doing it in this manner can lead to problems as you have found
with the actual Excel session still running.

Here is some code to findout the running instances of an application
In this case it is "Microsoft Excel" it is looking for, so be aware
it will search for Wnd Titles with this exact caption.
Note: You will need Xl2000+ as it uses the Address of Function not
available in Xl97.<PRE>Option Compare Text

Private DeclareFunctionEnumWindows Lib "user32" ( _ByVal lpEnumFuncAs Long, _ByVal lParamAs Long)As Long

Private DeclareFunctionGetWindowText Lib "user32" _

Alias "GetWindowTextA" ( _ByVal hwndAs Long, _ByVal lpStringAs String, _ByVal cchAs Long)As Long

Private pbExactAsBoolean

Private psAppStringAs String

Private piAppCountAs IntegerPublicFunctionAppInstances( _

AppNamePartAs String, _

Optional ExactMatchOnlyAsBoolean)As IntegerDimlRetAs Long

psAppString = AppNamePart

pbExact = ExactMatchOnly

lRet = EnumWindows(AddressOf CheckForInstance, 0)

AppInstances = piAppCountEnd Function

PrivateFunctionCheckForInstance(ByVal lhWndAs Long,ByVal _

lParamAs Long)As LongDimsTitleAs StringDimlRetAs LongDimiNewAs Integer

sTitle = Space(255)

lRet = GetWindowText(lhWnd, sTitle, 255)

sTitle = StripNull(sTitle)IfsTitle<> "" ThenIfpbExact ThenIfsTitle = psAppString ThenpiAppCount = piAppCount + 1ElseIfInStr(sTitle, psAppString) > 0 Then_

piAppCount = piAppCount + 1End IfEnd If

CheckForInstance = TrueEnd Function

PrivateFunctionStripNull(ByVal InStringAs String)As StringDimiNullAs IntegerIfLen(InString) > 0 Then

iNull = InStr(InString, vbNullChar)

SelectCaseiNullCase0

StripNull = InStringCase1

StripNull = ""CaseElse

StripNull = Left$(InString, iNull - 1)End SelectEnd IfEnd FunctionSubTestExcel()DimiXl_InstancesAs Integer

iXl_Instances = AppInstances("Microsoft Excel", False)

MsgBox iXl_Instances'// Need to use End and NOT iXl_Instances = 0'// otherwise running again increments instance'// appears that End exits the Enum call completley ??
EndEnd Sub</PRE>
_________________
Kind Regards, Ivan F Moala From the City of Sails

This message was edited by Ivan F Moala on 2002-08-31 20:22

XL-Dennis · Sep 1, 2002

Ivan,

Very Nice

BTW, except for asking You which are the best sources to learn more about Windows API?

TIA,
Dennis

Ivan F Moala · Sep 1, 2002

On 2002-09-01 02:04, XL-Dennis wrote:
Ivan,

Very Nice

BTW, except for asking You which are the best sources to learn more about Windows API?

TIA,
Dennis

Hi Dennis
Good sources
http://www.allapi.net/
http://www.vb2themax.com/

and a lot more, I generally just browse for
things that interest me and then play around
with it.....I learnt a lot from VB, but learnt VBA before going onto VB.

XL-Dennis · Sep 1, 2002

Ivan,

Thanks

OT:
AllApi is good resource although I regret that they, more or less, shutted it down.

I learnt a lot from VB, but learnt VBA before going onto VB.

So I have noticed :wink:
In general it's rather easy to find out if a user has a background in the VB-world or in the VBA-world :wink:

"VB-freaks" usually give me critism for the way I program and in general they usually solve problem by code instead of using XL:s built-in functionality :wink:

However, we have lot to learn from each other

Kind regards,
Dennis

Ian Mac · Sep 1, 2002

Ivan,

unfortunatly we use xl97, but I have gone with Dave's link which does work with 97;

Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10

Private Declare Function apiFindWindow Lib "user32" Alias _
"FindWindowA" (ByVal strClass As String, _
ByVal lpWindow As String) As Long

Private Declare Function apiSendMessage Lib "user32" Alias _
"SendMessageA" (ByVal Hwnd As Long, ByVal Msg As Long, ByVal _
wParam As Long, lParam As Long) As Long

Private Declare Function apiSetForegroundWindow Lib "user32" Alias _
"SetForegroundWindow" (ByVal Hwnd As Long) As Long

Private Declare Function apiShowWindow Lib "user32" Alias _
"ShowWindow" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function apiIsIconic Lib "user32" Alias _
"IsIconic" (ByVal Hwnd As Long) As Long

Function fIsAppRunning(ByVal strAppName As String, _
Optional fActivate As Boolean) As Boolean
Dim lngH As Long, strClassName As String
Dim lngX As Long, lngTmp As Long
Const WM_USER = 1024
On Local Error GoTo fIsAppRunning_Err
fIsAppRunning = False
Select Case LCase$(strAppName)
Case "excel": strClassName = "XLMain"
Case "word": strClassName = "OpusApp"
Case "access": strClassName = "OMain"
Case "powerpoint95": strClassName = "PP7FrameClass"
Case "powerpoint97": strClassName = "PP97FrameClass"
Case "notepad": strClassName = "NOTEPAD"
Case "paintbrush": strClassName = "pbParent"
Case "wordpad": strClassName = "WordPadClass"
Case Else: strClassName = ""
End Select

If strClassName = "" Then
lngH = apiFindWindow(vbNullString, strAppName)
Else
lngH = apiFindWindow(strClassName, vbNullString)
End If
If lngH <> 0 Then
apiSendMessage lngH, WM_USER + 18, 0, 0
lngX = apiIsIconic(lngH)
If lngX <> 0 Then
lngTmp = apiShowWindow(lngH, SW_SHOWNORMAL)
End If
If fActivate Then
lngTmp = apiSetForegroundWindow(lngH)
End If
fIsAppRunning = True
End If
fIsAppRunning_Exit:
Exit Function
fIsAppRunning_Err:
fIsAppRunning = False
Resume fIsAppRunning_Exit
End Function

The link took me to:

http://www.mvps.org/access/api/index.htm

Which has some other very useful stuff.

BUT! while I'm, another problem which is the underlining one after this hopefully works on Monday.
Is that the code throws an automation error back at line;

.SetSourceData Source:=Sheets("Progress Report").Range(Range), PlotBy:=xlColumns

There is definately something fishy going on as before I received these excellent answers I got a Global Error (I haven't the details to hand, but can provide them tomorrow) at the same line in the code for all three report I'm running from this database.
This is a consistant problem, as the reason I own the DB now is because they've ALWAYS had problems with charts in reports (they are Access through and through, whereas I'm mrexcel.com all the way).
I didn't get the nature of the problems from them, but I'm willing to stick my neck out as to where they had these problems.

I this something anyone has heard of, ALL of the Literature I have both Excel and Access points to the code being correct. I just can't figure the bleedin thing out???

Thank guys,

Ivan F Moala · Sep 1, 2002

Hi Ian
Post back on the Automation Error and Number
when you have the time...

Ian Mac · Sep 2, 2002

On 2002-09-01 21:52, Ivan F Moala wrote:
Hi Ian
Post back on the Automation Error and Number
when you have the time...

Run-Time error '-2147417851 (80010105)':

Automation error
The server threw an exception

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

Also at the same line, sometimes I get:

Run-time error '1004':

Method 'Sheets' of object '_Global' failed

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

And another:

Run-Time error '-2147023174 (800706ba)':

Automation error
The server threw an exception

Also, I've tried setting ALL the objects to Nothing;

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing

but excel is still sitting around hogging 9000+kb memory (greedy monkey).

Here's the testing results from this morning, this is for a report called Quality Report (inventive?):

Clean start, no Excel = OK
(Shut down Excel still in memory)
Re-run report with Excel in memory = OK
Re-run without closing Excel = OK
(Shut down Excel AND End the process in Task Manager
Start again (same as clean) = 3rd error message (automation).
Shut down the report, Excel still in memory re-run = OK
Open Excel fresh with Book 1 Unsaved, Run report = 2nd error message (the errors are ALWAYS at the same line)
Open Excel fresh with Book 1 saved, Run report = 2nd error message
Open Excel with an existing file .xls Re-run = OK
Remove Process.
Open Excel with .xlt = 1st error
Do not remove process.
Open Excel with .xlt = OK

It looks like the link with Access is still there, and if I remove it through task manager it get the hump.

I've also tested the other report and it seems to be the same BUT I don't get any errors at all, just the:

.SetSourceData Source:=Sheets("Progress Report").Range(Range), PlotBy:=xlColumns

doesn't happen, it sets the source data to A8 for some reason????

This only happens if I end the process through task manager, interestingly if I do that run the report then close it down, excel.exe does get removed from memory.
BUT if I run the report again it doesn't set the source data again.

I think that's all correct,

Thanks,

dmckinney · Sep 2, 2002

Hi again Ian....I was off on Friday...glad to see you're still having fun.

One thing that springs to mind is that your xl variables mightn't be recognised. (i.e. you might need to a) declare constants in Access or b) substitute values in their place.)

Otherwise if there's some code (files) you can send me, I'll try to reproduce and remedy.

Regards,

Dave.

Ian Mac · Sep 2, 2002

On 2002-09-02 03:02, dmckinney wrote:
Hi again Ian....I was off on Friday...glad to see you're still having fun.

One thing that springs to mind is that your xl variables mightn't be recognised. (i.e. you might need to a) declare constants in Access or b) substitute values in their place.)

Otherwise if there's some code (files) you can send me, I'll try to reproduce and remedy.

Regards,

Dave.

All I can do is post both pieces of code, as the DB itself has linked tables that I don't even know where they are.

It just seems odd that it happens at the same line for both, Setting the chart Source Data??

The following is throw back errors as described:

Code:

Private Sub QualityReport()

    If IsNull(Me.cmbAccount) Then
        MsgBox "Please select an account to run the report on.", vbCritical, "Run Quality Report"
        Me.cmbAccount.SetFocus
        Exit Sub
    End If
    
    Dim lRecordCount As Long, i As Integer, arrCSPs(), x As Integer, CSP As String, qdquery As QueryDef, sql As String
    Dim rstemp, rstemp2 As Recordset, query, query2, CallType As String
    Dim Monitored, TM As Integer
    
    z_Account = Me.cmbAccount
    If z_Account = "Bureau" Then
        GetAccount
        z_BeginDate = Me!txtBeginDate
        z_EndDate = DateAdd("d", 1, Me.txtEndDate)
        query = "select * from qryCSPBureau where " & sql
        
        
        Set qdquery = CurrentDb.QueryDefs("qryCSPBureauLookup")
        sql = "SELECT DISTINCT Main.CSP, Main.Account FROM qryAccountSorted INNER JOIN Main ON qryAccountSorted.Account = Main.Account WHERE (((qryAccountSorted.Bureau)=True) AND ((Main.CallDate) Between GetBeginDate() And GetEndDate()))"
        If Me.chkQA = True Then
            If Me.chkTM = True Then
                Monitored = 0
            Else
                Monitored = 1
                CallType = " AND ((Right([CallCoach],4))=" & Chr(34) & "(QA)" & Chr(34) & ")"
            End If
        Else
            If Me.chkTM = True Then
                Monitored = 2
                CallType = " AND ((Right([CallCoach],4))<>" & Chr(34) & "(QA)" & Chr(34) & ")"
            End If
        End If
        
        If Monitored > 0 Then
            sql = sql & CallType
        End If
        
        If Not IsNull(Me.cmbTM) Then
            z_TM = Me.cmbTM
            sql = sql & " AND ((Main.TeamManager)=GetTM())"
            TM = 1
        End If
        
        sql = sql & " ORDER By Main.CSP"
        qdquery.sql = sql
        
        lRecordCount = DCount("*", "qryCSPBureau")
        
        If lRecordCount = 0 Then
            MsgBox "No records"
            Exit Sub
        End If
        
        Set rstemp = CurrentDb.OpenRecordset("qryCSPBureau")
            
        rstemp.MoveFirst
        
        For i = lRecordCount To 1 Step -1
            ReDim Preserve arrCSPs(8, lRecordCount)
            arrCSPs(0, i - 1) = rstemp!CSP
            rstemp.MoveNext
        Next
        rstemp.Close
            
        'Set the values for the most recent 5 calls
        
        For i = lRecordCount To 1 Step -1
            
            z_CSPName = arrCSPs(0, i - 1)
            'query = "select * from qryTop5Bureau where CSP = " & Chr(34) & Trim(z_CSPName) & Chr(34) & " and " & Trim(sql)
            sql = "SELECT TOP 5 Main.OverallPer FROM qryAccountSorted INNER JOIN Main ON qryAccountSorted.Account = Main.Account WHERE (((Main.CSP)=GetCSP()) AND ((Main.CallDate) Between GetBeginDate() And GetEndDate()) AND ((qryAccountSorted.Bureau)=True))"
            Set qdquery = CurrentDb.QueryDefs("qryTop5Bureau")
            
            If Monitored > 0 Then
                sql = sql & CallType
            End If
            
            If TM = 1 Then
                sql = sql & " AND ((Main.TeamManager)=GetTM())"
            End If
            
            sql = sql & " GROUP BY Main.OverallPer, Main.CallDate ORDER BY Main.CallDate DESC"
            
            qdquery.sql = sql
            
            Set rstemp = CurrentDb.OpenRecordset("qryTop5Bureau")
            
            'If DCount("*", sql) = 0 Then
            '   MsgBox "There are no records"
            '    Exit Sub
            'End If
            
            rstemp.MoveFirst
            For x = 1 To 5
                    arrCSPs(x, i - 1) = rstemp!OverallPer
                    rstemp.MoveNext
                    If rstemp.EOF() Then x = 5
            Next
            
        Next
        rstemp.Close
        
        'Set the Highest and Lowest values
        'query = "select * from qryAllBureau where CSP = " & Chr(34) & z_CSPName & Chr(34) & " and " & sql
        sql = "SELECT Main.OverallPer FROM Main INNER JOIN qryAccountSorted ON Main.Account = qryAccountSorted.Account WHERE (((Main.CSP)=GetCSP()) AND ((Main.CallDate) Between GetBeginDate() And GetEndDate()) AND ((qryAccountSorted.Bureau)=True))"
        Set qdquery = CurrentDb.QueryDefs("qryAllBureau")
        
        If Monitored > 0 Then
            sql = sql & CallType
        End If
        
        If TM = 1 Then
            sql = sql & " AND ((Main.TeamManager)=GetTM())"
        End If
        
        sql = sql & " GROUP BY Main.OverallPer, Main.CallDate ORDER BY Main.CallDate DESC"
        qdquery.sql = sql
        
        For i = lRecordCount To 1 Step -1
            z_CSPName = arrCSPs(0, i - 1)
            Set rstemp = CurrentDb.OpenRecordset("qryAllBureau")
            rstemp.MoveFirst
           
            For x = 6 To 7
                arrCSPs(x, i - 1) = rstemp!OverallPer
                rstemp.MoveLast
            Next
           
        Next
        'query = "select * from qryAvgBureau where CSP = " & Chr(34) & z_CSPName & Chr(34) & " and " & sql
        
        Set qdquery = CurrentDb.QueryDefs("qryAvgBureau")
        sql = "SELECT Avg(Main.OverallPer) AS AvgOfOverallPer FROM Main INNER JOIN qryAccountSorted ON Main.Account = qryAccountSorted.Account WHERE (((Main.CSP)=GetCSP()) AND ((Main.CallDate) Between GetBeginDate() And GetEndDate()) AND ((qryAccountSorted.Bureau)=True))"
        
        If Monitored > 0 Then
            sql = sql & CallType
        End If
        
        If TM = 1 Then
            sql = sql & " AND ((Main.TeamManager)=GetTM())"
        End If
        
        qdquery.sql = sql
        
        For i = lRecordCount To 1 Step -1
            z_CSPName = arrCSPs(0, i - 1)
            Set rstemp = CurrentDb.OpenRecordset("qryAvgBureau")
            rstemp.MoveFirst
            arrCSPs(8, i - 1) = rstemp!AvgOfOverallPer
            If rstemp.EOF Then i = lRecordCount
            rstemp.MoveNext
        Next
    Else
        z_BeginDate = Me.txtBeginDate
        z_EndDate = DateAdd("d", 1, Me.txtEndDate)
        Set qdquery = CurrentDb.QueryDefs("qryCSP")
        sql = "SELECT DISTINCT Main.CSP, Main.Account FROM Main WHERE (((Main.Account)=GetAccount()) AND ((Main.CallDate) Between GetBeginDate() And GetEndDate()))"

        If Me.chkQA = True Then
            If Me.chkTM = True Then
                Monitored = 0
            Else
                Monitored = 1
                CallType = " AND ((Right([CallCoach],4))=" & Chr(34) & "(QA)" & Chr(34) & ")"
            End If
        Else
            If Me.chkTM = True Then
                Monitored = 2
                CallType = " AND ((Right([CallCoach],4))<>" & Chr(34) & "(QA)" & Chr(34) & ")"
            End If
        End If
        
        If Monitored > 0 Then
            sql = sql & CallType
        End If
        
        If Not IsNull(Me.cmbTM) Then
            z_TM = Me.cmbTM
            sql = sql & " AND ((Main.TeamManager)=GetTM())"
            TM = 1
        End If
        
        sql = sql & " ORDER by Main.CSP"
        
        qdquery.sql = sql
        
        lRecordCount = DCount("*", "qryCSP")
        
        If lRecordCount = 0 Then
            MsgBox "No records"
            Exit Sub
        End If
            
        Set rstemp = CurrentDb.OpenRecordset("qryCSP")
            
        rstemp.MoveFirst
        
        For i = lRecordCount To 1 Step -1
            ReDim Preserve arrCSPs(8, lRecordCount)
            arrCSPs(0, i - 1) = rstemp!CSP
            rstemp.MoveNext
        Next
        rstemp.Close
    
        'Set rstemp = CurrentDb.OpenRecordset("qryTop5")
            
        'Set the values for the most recent 5 calls
        
        Set qdquery = CurrentDb.QueryDefs("qryTop5")
        sql = "SELECT Main.OverallPer FROM Main WHERE (((Main.CallDate) Between GetBeginDate() And GetEndDate()) AND ((Main.CSP)=GetCSP()) AND ((Main.Account)=GetAccount()))"
        
        If Monitored > 0 Then
            sql = sql & CallType
        End If
        
        If TM = 1 Then
            sql = sql & " AND ((Main.TeamManager)=GetTM())"
        End If
        
        sql = sql & " GROUP BY Main.OverallPer, Main.CallDate ORDER BY Main.CallDate DESC"
        qdquery.sql = sql
        For i = 1 To lRecordCount
            
            z_CSPName = arrCSPs(0, i - 1)
            Set rstemp = CurrentDb.OpenRecordset("qryTop5")
            'Set rstemp2 = CurrentDb.OpenRecordset("qryAll")
            rstemp.MoveFirst
            'rstemp2.MoveFirst
            For x = 1 To 5
                    arrCSPs(x, i - 1) = rstemp!OverallPer
                    rstemp.MoveNext
                    If rstemp.EOF() Then x = 5
            Next
            
        Next
        rstemp.Close
        'rstemp2.Close
        
        'Set the Highest and Lowest values
        sql = "SELECT Main.OverallPer FROM Main WHERE (((Main.CallDate) Between GetBeginDate() And GetEndDate()) AND ((Main.CSP)=GetCSP()) AND ((Main.Account)=GetAccount()))"
        Set qdquery = CurrentDb.QueryDefs("qryAll")
        If Monitored > 0 Then
            sql = sql & CallType
        End If
        
        If TM = 1 Then
            sql = sql & " AND ((Main.TeamManager)=GetTM())"
        End If
        
        sql = sql & " GROUP BY Main.OverallPer ORDER BY Main.OverallPer DESC"
        
        qdquery.sql = sql
        
        For i = lRecordCount To 1 Step -1
            z_CSPName = arrCSPs(0, i - 1)
            Set rstemp = CurrentDb.OpenRecordset("qryAll")
            rstemp.MoveFirst
           
            For x = 6 To 7
                arrCSPs(x, i - 1) = rstemp!OverallPer
                rstemp.MoveLast
            Next
           
        Next
        
        Set qdquery = CurrentDb.QueryDefs("qryAvg")
        
        sql = "SELECT Avg(Main.OverallPer) AS AvgOfOverallPer FROM Main WHERE (((Main.CallDate) Between GetBeginDate() And GetEndDate()) AND ((Main.CSP)=GetCSP()) AND ((Main.Account)=GetAccount()))"
        If Monitored > 0 Then
            sql = sql & CallType
        End If
        
        If TM = 1 Then
            sql = sql & " AND ((Main.TeamManager)=GetTM())"
        End If
        qdquery.sql = sql
        
        For i = lRecordCount To 1 Step -1
            z_CSPName = arrCSPs(0, i - 1)
            Set rstemp = CurrentDb.OpenRecordset("qryAvg")
            rstemp.MoveFirst
            arrCSPs(8, i - 1) = rstemp!AvgOfOverallPer
            If rstemp.EOF Then i = lRecordCount
            rstemp.MoveNext
        Next
    End If
    
    Dim xlapp, xlBook, xlSheet As Object
    Dim MFILE As String
    
    
    'MFILE = "I:SoftechSoft-exReportsSiemens Database " & Format(Form_frmReports![txtCallDate], "DD") & "-" & Format(Form_frmReports![txtCallDate], "MM") & ".xls"
    Dim ChartTitle As String, Calls As String
    ChartTitle = z_Account
    If Not IsNull(Me.cmbTM) Then ChartTitle = ChartTitle & ", " & z_TM
    If Monitored = 0 Then Calls = ", QA & TM Calls"
    If Monitored = 1 Then Calls = ", QA Calls Only"
    If Monitored = 2 Then Calls = ", TM Calls Only"
    ChartTitle = ChartTitle & Calls
    
    ' Try to grab a running instance of
    ' Excel...

    ' What did we find?..
    
    If fIsAppRunning("Excel", True) Then
    Set xlapp = GetObject(, "Excel.Application")
    MsgBox "T"
    Else
    Set xlapp = CreateObject("Excel.Application")
    MsgBox "F"
    End If
    
    Set xlBook = xlapp.Workbooks.Add("gbnewdials01quality$downloadQualityReport.xlt")
    Set xlSheet = xlBook.Worksheets(1)
        
    xlapp.Visible = True
    xlapp.Application.Sheets("Quality Report").cells(2, "A") = ChartTitle
    xlapp.Application.Sheets("Quality Report").cells(3, "A") = "Date Period : " & Form_frmReports.txtBeginDate & " to " & Form_frmReports.txtEndDate
    Dim h As Integer, v As Integer
    For v = 7 To (lRecordCount + 6)
        For h = 1 To 9
            'MsgBox "Cells = " + Str$(v) + Chr$(h + 64) + "  and Array =" + Str$(v - 7) + "," + Str$(h - 1)
            xlapp.Application.Sheets("Quality Report").cells(v, Chr$(h + 64)) = arrCSPs(h - 1, v - 7)
            If h = 9 Then
                If arrCSPs(h - 1, v - 7) < 0.5 Then
                    For i = 1 To 8
                        xlapp.Application.Sheets("Quality Report").cells(v, Chr$(i + 65)).Interior.ColorIndex = 45
                    Next
                End If
                If arrCSPs(h - 1, v - 7) > 0.8 Then
                    For i = 1 To 8
                        xlapp.Application.Sheets("Quality Report").cells(v, Chr$(i + 65)).Interior.ColorIndex = 4
                    Next
                End If
            End If
            If v = (lRecordCount + 6) Then
                xlapp.Application.Sheets("Quality Report").cells(v, Chr$(h + 64)).Borders(4).LineStyle = 12
                xlapp.Application.Sheets("Quality Report").cells(v, Chr$(h + 64)).Borders(4).Weight = 3
            End If
        Next
    Next
    
    'If z_Account = "Bureau" Then
        'sql = "SELECT Avg(Main.TechnicalPer) AS AvgOfTechnicalPer, Avg(Main.SummarisingPer) AS AvgOfSummarisingPer, Avg(Main.BodyPer) AS AvgOfBodyPer, Avg(Main.OpeningPer) AS AvgOfOpeningPer, Avg(Main.OverallPer) AS AvgOfOverallPer, Count(Main.ID) AS CountOfID FROM Main INNER JOIN qryAccountSorted ON Main.Account = qryAccountSorted.Account WHERE (((qryAccountSorted.Bureau)=True) AND ((Main.CallDate) Between GetBeginDate() And GetEndDate()))"
        'Set qdquery = CurrentDb.QueryDefs("qryGraphBureau")
        'If Monitored > 0 Then
        '    sql = sql & CallType
        'End If
        '
        'If TM = 1 Then
        '    sql = sql & " AND ((Main.TeamManager)=GetTM())"
        'End If
        'qdquery.sql = sql
        '
        'Set rstemp = CurrentDb.OpenRecordset("qryGraphBureau")
    'Else
    
        sql = "SELECT Avg(Main.TechnicalPer) AS AvgOfTechnicalPer, Avg(Main.SummarisingPer) AS AvgOfSummarisingPer, Avg(Main.BodyPer) AS AvgOfBodyPer, Avg(Main.OpeningPer) AS AvgOfOpeningPer, Avg(Main.OverallPer) AS AvgOfOverallPer, Count(Main.ID) AS CountOfID FROM Main WHERE (((Main.CallDate) Between GetBeginDate() And GetEndDate()) AND ((Main.Account)=GetAccount()))"
        Set qdquery = CurrentDb.QueryDefs("qryGraph")
        If Monitored > 0 Then
            sql = sql & CallType
        End If
        
        If TM = 1 Then
            sql = sql & " AND ((Main.TeamManager)=GetTM())"
        End If
        qdquery.sql = sql
        
        Set rstemp = CurrentDb.OpenRecordset("qryGraph")
    'End If
    
    With xlapp.Application
        With .Sheets("Quality Report")
            .cells(v + 1, Chr(h + 63)) = rstemp!CountOfID
            .cells(v + 1, Chr(h + 63)).NumberFormat = "0"
            .cells(v + 1, Chr(h + 61)).HorizontalAlignment = xlLeft
            .cells(v + 1, Chr(h + 61)) = "Total Calls Monitored"
    
            .cells(v, Chr$(h + 61)) = "Campaign Average"
            .cells(v, Chr$(h + 61)).HorizontalAlignment = xlLeft
            .cells(v, Chr$(h + 63)) = rstemp!AvgOfOverallPer
        End With
        With .Sheets("Graph")
            .cells(1, "G") = "Opening"
    'xlapp.Application.Sheets("Graph").cells(1, "G").Font.ColorIndex = 48
            .cells(1, "H") = "Body"
    'xlapp.Application.Sheets("Graph").cells(1, "H").Font.ColorIndex = 48
            .cells(1, "I") = "Summarising"
    'xlapp.Application.Sheets("Graph").cells(1, "I").Font.ColorIndex = 48
            .cells(1, "J") = "Technical"
    'xlapp.Application.Sheets("Graph").cells(1, "J").Font.ColorIndex = 48
            .cells(2, "G") = rstemp!AvgOfOpeningPer
    'xlapp.Application.Sheets("Graph").cells(2, "G").Font.ColorIndex = 48
            .cells(2, "H") = rstemp!AvgOfBodyPer
    'xlapp.Application.Sheets("Graph").cells(2, "H").Font.ColorIndex = 48
            .cells(2, "I") = rstemp!AvgOfSummarisingPer
    'xlapp.Application.Sheets("Graph").cells(2, "I").Font.ColorIndex = 48
            .cells(2, "J") = rstemp!AvgOfTechnicalPer
    'xlapp.Application.Sheets("Graph").cells(2, "J").Font.ColorIndex = 48
    
        End With
    
    Dim xlWs As Object
    'Set xlWs = Nothing
    'Set xlWs = xlapp.Worksheets("Graph")
    
    'xlWs.Sheets("Graph").Select
        .Charts.Add
        .ActiveChart.ChartType = xlColumnClustered
        .ActiveChart.SetSourceData Source:=Sheets("Graph").Range("G1:J2"), PlotBy:= _
        xlRows
        .ActiveChart.Location Where:=xlLocationAsObject, Name:="Graph"
    'xlapp.Application.ActiveChart.SeriesCollection(1).XValues = "=Graph!G1:J2"
        .ActiveChart.Location Where:=xlLocationAsObject, Name:="Graph"
        .ActiveChart.HasTitle = True
        .ActiveChart.HasLegend = False
        .ActiveChart.ChartTitle.Characters.Text = ChartTitle & " (" & Me.txtBeginDate & " - " & Me.txtEndDate & ")"
        .ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = False
        .ActiveChart.Axes(xlValue, xlPrimary).HasTitle = False
        .ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
        .Sheets("Graph").Select
        .Sheets("Graph").Move After:=Sheets(2)
        .Sheets("Quality Report").Select

    Set xlWs = Nothing
    
    End With
    
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing

End Sub

The second DOESN'T give any errors but doesn't reference the correct area for the data, this happens at all the ame points as the other one throw an error:

Code:

Private Sub PerformanceAnalysis()

Dim Weeks As Double, Remainder As Boolean, i As Integer, rstemp As Recordset, StartDate, StopDate As Date, arrPerf(), qdquery As QueryDef
Dim sql, ByTM, ByAccount, ByCSP, ChartTitle, CallType As String, Monitored As Integer

Set qdquery = CurrentDb.QueryDefs("qryProgressByAccount")

sql = "SELECT Avg(Main.BodyPer) AS AvgOfBodyPer, Avg(Main.SummarisingPer) AS AvgOfSummarisingPer, Avg(Main.TechnicalPer) AS AvgOfTechnicalPer, Avg(Main.OpeningPer) AS AvgOfOpeningPer, Avg(Main.OverallPer) AS AvgOfOverallPer FROM Main WHERE (((Main.CallDate) Between GetBeginDate() And GetEndDate())"
ByAccount = " AND ((Main.Account)=GetAccount()))"
ByTM = " AND ((Main.TeamManager)=GetTM())"
ByCSP = " AND ((Main.CSP)=GetCSP())"
ChartTitle = ""
If Not IsNull(Me.cmbCSP) Then
    sql = sql & ByCSP
    z_CSPName = Me.cmbCSP
    ChartTitle = z_CSPName
End If

If Not IsNull(Me.cmbAccount) Then
    sql = sql & ByAccount
    z_Account = Me.cmbAccount
    If ChartTitle <> "" Then
        ChartTitle = ChartTitle & ", " & z_Account
    Else
        ChartTitle = z_Account
    End If
End If

If Me.chkQA = True Then
    If Me.chkTM = True Then
        Monitored = 0
    Else
        Monitored = 1
        CallType = " AND ((Right([CallCoach],4))=" & Chr(34) & "(QA)" & Chr(34) & ")"
    End If
Else
    If Me.chkTM = True Then
        Monitored = 2
        CallType = " AND ((Right([CallCoach],4))<>" & Chr(34) & "(QA)" & Chr(34) & ")"
    End If
End If

If Monitored > 0 Then
    qdquery.sql = (sql & CallType)
Else
    qdquery.sql = (sql)
End If

If Not IsNull(Me.cmbTM) Then
    qdquery.sql = qdquery.sql & ByTM
    z_TM = Me.cmbTM
    ChartTitle = ChartTitle & ", (" & z_TM & "'s team)"
End If

qdquery.Close

z_BeginDate = Me.txtBeginDate
z_EndDate = DateAdd("d", 1, Me.txtEndDate)
StopDate = z_EndDate
StartDate = z_BeginDate

ChartTitle = ChartTitle & " Analysis, " & StartDate & " - " & DateAdd("d", -1, StopDate)

If Me.chkQA = True And Me.chkTM = True Then
    ChartTitle = ChartTitle & " , (QA & TM Calls)"
Else
    If Me.chkQA = True Then
        ChartTitle = ChartTitle & " , (QA Calls only)"
    Else
        ChartTitle = ChartTitle & " , (TM Calls only)"
    End If
End If

Weeks = (z_EndDate - z_BeginDate) / 7

If Len(Trim((Str$(Weeks)))) > 1 Then
    Weeks = Int(Weeks)
    Remainder = True
Else
    Remainder = False
End If

z_EndDate = DateAdd("d", 7, z_BeginDate)
For i = 1 To Weeks
    Set rstemp = CurrentDb.OpenRecordset("qryProgressByAccount")
    If Not rstemp.EOF Then
        ReDim Preserve arrPerf(6, Weeks)
        rstemp.MoveFirst
        arrPerf(0, i - 1) = Str$(z_BeginDate) & " - " & Str$(DateAdd("d", -1, z_EndDate))
        arrPerf(1, i - 1) = rstemp!AvgOfOpeningPer
        arrPerf(2, i - 1) = rstemp!AvgOfBodyPer
        arrPerf(3, i - 1) = rstemp!AvgOfSummarisingPer
        arrPerf(4, i - 1) = rstemp!AvgOfTechnicalPer
        arrPerf(5, i - 1) = rstemp!AvgOfOverallPer
        rstemp.MoveNext
        z_BeginDate = DateAdd("d", 7, z_BeginDate)
        z_EndDate = DateAdd("d", 7, z_EndDate)
    End If
Next

If Remainder = True Then
    z_EndDate = StopDate
    If z_BeginDate < z_EndDate Then
        Set rstemp = CurrentDb.OpenRecordset("qryProgressByAccount")
        If Not rstemp.EOF Then
            ReDim Preserve arrPerf(6, Weeks + 1)
            arrPerf(0, i - 1) = Str$(z_BeginDate) & " - " & Str$(DateAdd("d", -1, z_EndDate))
            arrPerf(1, i - 1) = rstemp!AvgOfOpeningPer
            arrPerf(2, i - 1) = rstemp!AvgOfBodyPer
            arrPerf(3, i - 1) = rstemp!AvgOfSummarisingPer
            arrPerf(4, i - 1) = rstemp!AvgOfTechnicalPer
            arrPerf(5, i - 1) = rstemp!AvgOfOverallPer
            rstemp.MoveFirst
        End If
    End If
End If
rstemp.Close

Dim objXL
Dim xlapp, xlBook, xlSheet As Object
Dim MFILE As String

' Try to grab a running instance of
' Excel...

' What did we find?..
        
If fIsAppRunning("Excel", True) Then
Set xlapp = GetObject(, "Excel.Application")
'MsgBox "T"
Else
Set xlapp = CreateObject("Excel.Application")
'MsgBox "F"
End If

Set xlBook = xlapp.Workbooks.Open("gbnewdials01quality$downloadProgressReport.xlt ")
Set xlSheet = xlBook.Worksheets(1)

xlapp.Visible = True

With xlapp.Application
    .Sheets("Progress Report").cells(2, "A") = "Account : " & z_Account
    .Sheets("Progress Report").cells(3, "A") = "Date Period : " & Form_frmReports.txtBeginDate & " to " & Form_frmReports.txtEndDate
Dim h As Integer, v As Integer
For v = 7 To ((IIf(Remainder = True, Weeks + 1, Weeks)) + 7)
    For h = 0 To 5
        xlapp.Application.Sheets("Progress Report").cells(v, Chr$(h + 65)) = arrPerf(h, v - 7)
    Next
Next

Dim Range As String, n As Integer
Range = "A6:F"
Range = Range & Trim(Str$(IIf(Remainder = True, (7 + Weeks), (6 + Weeks))))
    .Charts.Add

With .Charts(1)
    .ChartType = xlLineMarkers
    .Location Where:=xlLocationAsNewSheet, Name:="Graph"
    On Error Resume Next
    .SetSourceData Source:=Sheets("Progress Report").Range(Range), PlotBy:=xlColumns
    .HasTitle = True
    .ChartTitle.Characters.Text = ChartTitle
    .Axes(xlValue, xlPrimary).HasTitle = False
    .Axes(xlCategory, xlPrimary).HasTitle = False

If .SeriesCollection.Count > 0 Then
For n = 1 To 5
    If n = 5 Then
        .SeriesCollection(n).Border.Weight = xlThick
    End If
        .SeriesCollection(n).Smooth = True
Next

        .SeriesCollection(4).Border.ColorIndex = 5
        .SeriesCollection(4).MarkerForegroundColorIndex = 5
        .Axes(xlCategory).TickLabels.Orientation = 45
End If
End With
End With

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
        
End Sub

As you say I'm still having fun.
I wish I was a programmer sometimes instead of just a Cobbler of Code.

Thanks,

Ivan F Moala · Sep 2, 2002

Hi Ian
1st Code;

You need to Quit Excel 1st then Set to Nothing

eg
<pre/>
xlapp.DisplayAlerts = False
xlapp.Quit

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
</pre>

2nd Code

You need to reference the range correctly

eg

<pre/>
.SetSourceData Source:=xlapp.Application.Sheets("Progress Report").Range(Range), PlotBy:=xlColumns

AND NOT

.SetSourceData Source:=Sheets("Progress Report").Range(Range), PlotBy:=xlColumns
.SetSourceData
</pre>
'
'
'
PLUS @ End of Code
'
<pre/>
xlapp.DisplayAlerts = False
xlapp.Quit

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
</pre>

Note: Could Test! but try thes changes

Access/Excel interaction...excel.exe problem

Ian Mac

MrExcel MVP

Ivan F Moala

MrExcel MVP

Excel Facts

XL-Dennis

Well-known Member

Ivan F Moala

MrExcel MVP

XL-Dennis

Well-known Member

Ian Mac

MrExcel MVP

Ivan F Moala

MrExcel MVP

Ian Mac

MrExcel MVP

dmckinney

Board Regular

Ian Mac

MrExcel MVP

Ivan F Moala

MrExcel MVP

Similar threads

Forum statistics

Share this page

Access/Excel interaction...excel.exe problem

MrExcel MVP

MrExcel MVP

Excel Facts

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

MrExcel MVP

MrExcel MVP

Board Regular

MrExcel MVP

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock