VBA access - Evaluate error 2

[ItIsHardToProgram]

Hello all!, I am getting the following error:
execution error 50290, Evaluate object method failed.

when running the following code:

Do
        For Each ws In Sheets(Array("JfSommaire", "MaSommaire", "MartinSommaire", "BrunoSommaire", "JimSommaire", "NancySommaire", "GuillaumeSommaire"))
            [bold]For Each r In ws.Range(ws.[A4], ws.[A4].End(xlDown))[/bold]
                If ws.Cells(r.Row, 1) = rst.Fields("IDProjet") Then
                    ws.Cells(r.Row, 9).Value = rst.Fields("Honoraire utilisé")
                End If
            Next
        Next

        
        rst.MoveNext
    
    Loop Until rst.EOF

The error occurs on the bold line.

The variable "r" holds nothing.

Here are the declarations:

    Dim appExcel As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet

    Dim ws As Worksheet, r As Range
    Dim rst As Recordset

The code runs fine for a while, but at some point it hits something that gives the error mentioned above. Am I doing this wrong? By the way, that part of the code was provided by a tek-tip M.V.P.

Thanks, don't hesitate to ask for more.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[SkipVought]

hi,

I'd guess that its in your declaration...

    Dim appExcel As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet

    Dim ws As [b][red]Excel.[/red][/b]Worksheet, r As [b][red]Excel.[/red][/b]Range

since you must be coding in an application other than Excel.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[PHV]

What about this ?
For Each r In ws.Range(ws.Range("A4"), ws.Range("A4").End(xlDown))

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[ItIsHardToProgram]

Thanks for the correction skip, but it seems not to be the problem.

After your changes PHV, the code errors with the same error on the following line:

Do
        For Each ws In Sheets(Array("JfSommaire", "MaSommaire", "MartinSommaire", "BrunoSommaire", "JimSommaire", "NancySommaire", "GuillaumeSommaire"))
            For Each r In ws.Range(ws.[A4], ws.[A4].End(xlDown))
                If ws.Cells(r.Row, 1) = rst.Fields("IDProjet") Then
                    [b]ws.Cells(r.Row, 9).Value = rst.Fields("Honoraire utilisé")[/b]
                End If
            Next
        Next

        
        rst.MoveNext
    
    Loop Until rst.EOF

The line is in bold.



"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[ItIsHardToProgram]

Correction....

Apparantly, the second time I ran it it runned smooth, Somewhat unstable you could say... Maybe you could explain what the error is due to, to help me better understand?

I will continue constant testing, maybe if I improve the code then it might work?

Here is the code as a whole to help you understand more or less the applications role.

Function TransfertExcelAutomation(strSQL As String, _
sEmplacement As String)

On Error GoTo err_Handler

    'Excel object variables
    Dim appExcel As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet
    
    Dim sTemplate As String
    Dim sTempFile As String
    Dim sOutput As String
    
    Dim dbs As DAO.Database
    Dim sSQL As String
    Dim IRecords As Long
    Dim iRow As Integer
    Dim iCol As Integer
    Dim iFld As Integer
    Dim ProjectID As String
    
    Dim ws As Excel.Worksheet, r As Excel.Range
    Dim rst As Recordset
    
    Dim i As Integer
    
    Const cTabOne As Byte = 1
    Const cTabTwo As Byte = 2
    Const cStartRow As Byte = 3
    Const cStartColumn As Byte = 1
    
    iRow = 4
    
    DoCmd.Hourglass True
    
    'Set to break on all errors
    Application.SetOption "Error Trapping", 0
    
    'Start with clean file built from template file
    'sTemplate = sEmplacement & "\BrunoInterface.xls"
    sOutput = sEmplacement & "\MarcInterface.xls"
'    If Dir(sOutput) <> "" Then Kill sOutput
    'FileCopy sTemplate, sOutput
    
    'Create the Excel Application, Workbook and Worksheet and Database object
    Set appExcel = New Excel.Application
    appExcel.Visible = True
    'MsgBox (sOutput)
    Set wbk = appExcel.Workbooks.Open(sOutput)
    
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
    If Not rst.BOF Then rst.MoveFirst
      'For this template, the data must be placed in the appropriate cells of the spreadsheet

    Do
        For Each ws In Sheets(Array("JfSommaire", "MaSommaire", "MartinSommaire", "BrunoSommaire", "JimSommaire", "NancySommaire", "GuillaumeSommaire"))
            For Each r In ws.Range(ws.Range("A4"), ws.Range("A4").End(xlDown))
                If ws.Cells(r.Row, 1) = rst.Fields("IDProjet") Then
                    ws.Cells(r.Row, 9).Value = rst.Fields("Honoraire utilisé")
                End If
            Next
        Next

        
        rst.MoveNext
    
    Loop Until rst.EOF

    rst.Close
    
MsgBox ("Database closed")

exit_Here:
'Cleanup all objects (resume next on errors)
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
i = 0
Exit Function

err_Handler:
    ExportQuery = Err.Description
    Resume exit_Here
           
            
        
End Function

Unwanted behaviors: Needs to have the excel sheet referenced open AND opens a new copy read only to do the changes.

Sometimes gives a random error (as you can see)

Can't be ran on a strictly database point of view, (has to open excel to write on the sheet + dosnt save automaticaly in a specific location with date (This I can add.)

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[ItIsHardToProgram]

Third run, error on line mentioned...

sigh

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[ItIsHardToProgram]

Thank you for letting me chew my own meal:

Everything is fine and dandy.

Function TransfertExcelAutomation(strSQL As String, _
sEmplacement As String)

On Error GoTo err_Handler

    'Excel object variables
    Dim appExcel As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet
    
    Dim sTemplate As String
    Dim sTempFile As String
    Dim sOutput As String
    Dim sDAte As String
    
    Dim dbs As DAO.Database
    Dim sSQL As String
    Dim IRecords As Long
    Dim iRow As Integer
    Dim iCol As Integer
    Dim iFld As Integer
    Dim iWbk As Integer
    Dim ProjectID As String
    
    Dim ws As Excel.Worksheet, r As Excel.Range
    Dim rst As Recordset
    
    Dim i As Integer
    
    Const cTabOne As Byte = 1
    Const cTabTwo As Byte = 2
    Const cStartRow As Byte = 3
    Const cStartColumn As Byte = 1
    
    iRow = 4
    
       
    DoCmd.Hourglass True
    
    'Set to break on all errors
    Application.SetOption "Error Trapping", 0
    
    'Start with clean file built from template file
    'sTemplate = sEmplacement & "\BrunoInterface.xls"
    sOutput = sEmplacement & "\MarcInterface.xls"
'    If Dir(sOutput) <> "" Then Kill sOutput
    'FileCopy sTemplate, sOutput
    
    'Create the Excel Application, Workbook and Worksheet and Database object
    Set appExcel = New Excel.Application
    appExcel.Visible = False
    'MsgBox (sOutput)
    Set wbk = appExcel.Workbooks.Open(sOutput)
    iWbk = Workbooks.Count
    
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
    If Not rst.BOF Then rst.MoveFirst
      'For this template, the data must be placed in the appropriate cells of the spreadsheet

    Do
        For Each ws In Workbooks(iWbk).Sheets(Array("JfSommaire", "MaSommaire", "MartinSommaire", "BrunoSommaire", "JimSommaire", "NancySommaire", "GuillaumeSommaire"))
            For Each r In ws.Range(ws.Range("A4"), ws.Range("A4").End(xlDown))
                If ws.Cells(r.Row, 1) = rst.Fields("IDProjet") Then
                    ws.Cells(r.Row, 9).Value = rst.Fields("Honoraire utilisé")
                End If
            Next
        Next

        
        rst.MoveNext
    
    Loop Until rst.EOF

    rst.Close
    

exit_Here:
'Cleanup all objects (resume next on errors)
'Set wbk = Nothing
MsgBox (Date)
sDAte = Date

Workbooks(iWbk).SaveAs FileName:=sEmplacement & "\" & "MarcInterface" & "-" & sDAte & ".xls"
appExcel.Quit
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
i = 0
Exit Function

err_Handler:
    ExportQuery = Err.Description
    Resume exit_Here
           
            
        
End Function

Just a tad of cleanup and everything should be perfect!

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.