Adjusting values in Excel from Access

[trebor3900]

I have a database that adds the details of orders to a spreadsheet <Order Book>when they are made.
This works fine
When the orders are recieved the same spreadsheet<Order Book> is opened, the corresponding record is found and updated with receipt number and receipt date.
The following code when called achieves this successfully

Public Sub AmmendOrderBookReceipt()
Dim intRecords As Integer
Dim objXLApp As Object
Dim objXLWb As Excel.Workbook
Dim objXLWs As Excel.Worksheet
Dim db As DAO.Database
Dim qdfItem As DAO.QueryDef
Dim rsItem As DAO.Recordset
Dim SaveLocation As String
Dim yearstr As String ' current Accounting Year
Dim intRow As Integer
Dim RefNo As String
Dim found As Boolean
Dim RecRefNo As String
Dim fso As Object

On Error GoTo Err_AmmendOrderBookReceipt

txtYear.SetFocus
yearstr = Mid(txtYear.Text, 3, 2) & Right(txtYear.Text, 2) ' Takes the last two numbers from start year and end year

Set fso = CreateObject("Scripting.FileSystemObject")


intRecords = DCount("*", "qryUpdateUnitOrderBookRecieved")
If intRecords > 0 Then ' checks that there is a record
    Set db = CurrentDb
    Set qdfItem = db.QueryDefs("qryUpdateUnitOrderBookRecieved")
    Set rsItem = qdfItem.OpenRecordset ' List of items recieved
    rsItem.MoveFirst
    SaveLocation = getpath(db.Name) & "Vouchers\UnitOrderBook_" & yearstr & ".xls"
    'Creates Excel object
    Set objXLApp = CreateObject("Excel.Application")
    Set objXLWb = objXLApp.Workbooks.Open(SaveLocation)
    Set objXLWs = objXLWb.Worksheets("UnitOrderBook") ' Sets active Worksheet
    Set rsItem = db.OpenRecordset("qryUpdateUnitOrderBookRecieved", dbOpenDynaset)
    
    If fso.FileExists(SaveLocation) Then
        
        While Not rsItem.EOF ' Check for end of recordset
            found = False
            RecRefNo = rsItem!ReferenceNo
            
            ' Loop searches for matching Reference number
            intRow = 6 ' Starting row to be searched
            RefNo = objXLWs.Cells(intRow, 1)
            While RefNo <> ""
                RefNo = objXLWs.Cells(intRow, 1)
                If RefNo = RecRefNo Then
                    RefNo = ""
                    found = True
                Else
                    intRow = intRow + 1 ' increments until it finds an empty row or a match
                End If
            Wend
            
            'Only updates the current location if match found
            If found Then
                With objXLWs ' Populates the worksheet with recordset data
                    .Cells(intRow, 8) = (rsItem!ReceiptVoucherNo)
                    .Cells(intRow, 9) = (rsItem!DateRecieved)
                    .Cells(intRow, 10) = (rsItem!DateIssued)
                End With
            End If
        rsItem.MoveNext ' Move to the next record in recordset
        Wend
        
    End If
    'Update Unit Order Record here
    DoCmd.OpenQuery "qryUpdateUnitOrderBook"
    
    
    ' Clear object variables from memory
    objXLWb.Close SaveChanges:=True
    objXLApp.Quit
    
    Set objXLWs = Nothing
    Set objXLWb = Nothing
    Set objXLApp = Nothing
    rsItem.Close
    Set rsItem = Nothing
End If


Exit_Err_AmmendOrderBookReceipt:
        
Exit Sub

Err_AmmendOrderBookReceipt:
   
    MsgBox Err.Description
    Resume Exit_Err_AmmendOrderBookReceipt
  
End Sub

I then realised that if items were recieved in the next accounting year they would not be found in the current accounting years Order Book.

So i changed the above code to that shown below in order to accommodate this, but somewhere in the translation it stopped working.
Showing the error "Runtime error '3061' too few parameters. Expected 1."

ammended code:

Public Sub AmmendOrderBookReceipt()
Dim intRecords As Integer
Dim objXLApp As Object
Dim objXLWb As Excel.Workbook
Dim objXLWs As Excel.Worksheet
Dim db As DAO.Database
Dim qdfItem As DAO.QueryDef
Dim rsItem As DAO.Recordset
Dim queryYear As String
Dim SaveLocation As String
Dim yearstr As String
Dim prevyearstr As String
Dim currentyear As String ' current Accounting Year
Dim prevyear As String
Dim intRow As Integer
Dim RefNo As String
Dim found As Boolean
Dim RecRefNo As String
Dim fso As Object
Dim i As Integer

'On Error GoTo Err_AmmendOrderBookReceipt

txtYear.SetFocus
currentyear = txtYear.Text ' current Accounting year
prevyear = (Left(currentyear, 4) - 1) & "/" & (Right(currentyear, 4) - 1) ' previous Accounting year

' Checks updates for this years Unit Record Book
' and last years Unit Record Book
For i = 1 To 2
    If i = 1 Then
        yearstr = Mid(currentyear, 3, 2) & Right(currentyear, 2) ' Takes the last two numbers from start year and end year
        queryYear = "qryUpdateThisYearsOrderBook"
    Else
        yearstr = Mid(prevyear, 3, 2) & Right(prevyear, 2) ' Takes the last two numbers from start year and end year
        queryYear = "qryUpdateLastYearsOrderBook"
    End If
    Set fso = CreateObject("Scripting.FileSystemObject")
    intRecords = DCount("*", queryYear)
    If intRecords > 0 Then ' checks that there is a record
        Set db = CurrentDb
        Set qdfItem = db.QueryDefs(queryYear)
        Set rsItem = qdfItem.OpenRecordset ' List of items recieved
        Set rsItem = db.OpenRecordset(queryYear, dbOpenDynaset)
        rsItem.MoveFirst
        SaveLocation = getpath(db.Name) & "Vouchers\UnitOrderBook_" & yearstr & ".xls"
        'Creates Excel object
        Set objXLApp = CreateObject("Excel.Application")
        Set objXLWb = objXLApp.Workbooks.Open(SaveLocation)
        Set objXLWs = objXLWb.Worksheets("UnitOrderBook") ' Sets active Worksheet
    
        If fso.FileExists(SaveLocation) Then
            While Not rsItem.EOF ' Check for end of recordset
                found = False
                RecRefNo = rsItem!ReferenceNo
            
                ' Loop searches for matching Reference number
                ' to find corresponding file in spreadsheet
                intRow = 6 ' Starting row to be searched
                RefNo = objXLWs.Cells(intRow, 1)
                While RefNo <> ""
                    RefNo = objXLWs.Cells(intRow, 1)
                    If RefNo = RecRefNo Then
                        RefNo = ""
                        found = True
                    Else
                        intRow = intRow + 1 ' increments until it finds an empty row or a match
                    End If
                Wend
            
                'Only updates the current location if match found
                If found Then
                    With objXLWs ' Populates the worksheet with recordset data
                        .Cells(intRow, 8) = (rsItem!ReceiptVoucherNo)
                        .Cells(intRow, 9) = (rsItem!DateRecieved)
                        .Cells(intRow, 10) = (rsItem!DateIssued)
                    End With
                End If
            rsItem.MoveNext ' Move to the next record in recordset
            Wend
        
        End If
    
    
    
        ' Clear object variables from memory
        objXLWb.Close SaveChanges:=True
        objXLApp.Quit
    
        Set objXLWs = Nothing
        Set objXLWb = Nothing
        Set objXLApp = Nothing
        rsItem.Close
        Set rsItem = Nothing
    End If
Next i

'Update Unit Order Record here
DoCmd.OpenQuery "qryUpdateUnitOrderBook"

Exit_Err_AmmendOrderBookReceipt:
        
Exit Sub

Err_AmmendOrderBookReceipt:

    MsgBox Err.Description
    Resume Exit_Err_AmmendOrderBookReceipt
  
End Sub

Anyone see where i have gone wrong?

 

[trebor3900]

Forgot to mention that the program falls over on the following line of code:

Set rsItem = qdfItem.OpenRecordset

 

[mcirvine]

Not sure, but might be because ur setting twice rsItem

 

[trebor3900]

i thought that, but i tried taking one instance out. This did not affect the previous code sample either.

Thanks anyway