Thanks for your reply Ken
The complete Procedure follows;
Public Sub ExportToSpreadsheet()
Dim objExcel As Object
Dim qdf As QueryDef
Dim rs As Recordset
Dim intCurrentRow As Integer, intRecordCount As Integer,
intCurrentChargeField As Integer
'On Error GoTo Err_ExportToSpreadsheet
'make sure data exists for the selected batch
If IsNull(DLookup("InvoiceNo", "tblInvoiceDetail", "[InvoiceNo] = " &
Forms!frmPrintInvoices!txtInvoiceNo)) Then
MsgBox "Cannot find any invoice charges for Invoice: " &
Forms!frmPrintInvoices!txtInvoiceNo & "." & vbCrLf & _
"Export cancelled.", vbCritical, "Attention!"
Exit Sub
End If
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add
objExcel.Worksheets(1).Name = "HL Invoice Charges" 'Name 'Sheet1' tab
'Need to assign to a query def and reset the parameter - otherwise, Access
generates '3061: Too few parameters. Expected 1'
Set qd = CurrentDb.QueryDefs!qryInvoiceDetail_rptInvoiceByInvoiceNo
qd.Parameters(0) = [Forms]![frmPrintInvoices].[txtInvoiceNo]
Set rs = qd.OpenRecordset
If Not rs.EOF Then
rs.MoveLast
intRecordCount = rs.RecordCount
rs.MoveFirst
End If
intCurrentRow = 3 'begin at row 3
With objExcel.Worksheets(1)
Do While Not rs.EOF
intCurrentRow = intCurrentRow + 1
.Cells(intCurrentRow, 1).Value = rs(4) 'JobNo
.Cells(intCurrentRow, 3).Value = rs!RunDate
.Cells(intCurrentRow, 4).Value = rs!RefNos
.Cells(intCurrentRow, 5).Value = rs!Amount
'With rs 'include charge details where applicable
If rs!CostOfLoad > 0 Then
.Cells(intCurrentRow, 2).Value = "Cost of Load : £" &
rs!CostOfLoad
intCurrentRow = intCurrentRow + 1
End If
If rs!NoOfPallets > 0 And rs!ChargePerPallet Then 'check first of
each pair - starting with field 19 (No Of Pallets)
.Cells(intCurrentRow, 2).Value = "No of Pallets : " &
rs!NoOfPallets & Space(6 - Len(rs!NoOfPallets) + 3) & "@ £" &
rs!ChargePerPallet & " per Pallet"
intCurrentRow = intCurrentRow + 1
End If
If rs!PricePerTonne > 0 And rs!Tonnage > 0 Then 'check first of
each pair - starting with field 19 (No Of Pallets)
.Cells(intCurrentRow, 2).Value = "Tonnage : " & rs!Tonnage
& Space(6 - Len(rs!Tonnage) + 3) & "@ £" & rs!PricePerTonne & " per Tonne"
intCurrentRow = intCurrentRow + 1
End If
If rs!NoOfDays > 0 And rs!CostPerDay > 0 Then 'check first of each
pair - starting with field 19 (No Of Pallets)
.Cells(intCurrentRow, 2).Value = "No Of Days : " &
rs!NoOfDays & Space(6 - Len(rs!NoOfDays) + 3) & "@ £" & rs!CostPerDay & "
per Day"
intCurrentRow = intCurrentRow + 1
End If
If rs!NoOfMiles > 0 And rs!CostPerMile > 0 Then 'check first of
each pair - starting with field 19 (No Of Pallets)
.Cells(intCurrentRow, 2).Value = "No of Miles : " &
rs!NoOfMiles & Space(6 - Len(rs!NoOfMiles) + 3) & "@ £" & rs!CostPerMile &
" per Mile"
intCurrentRow = intCurrentRow + 1
End If
If rs!NoOfNights > 0 And rs!CostPerNight > 0 Then 'check first of
each pair - starting with field 19 (No Of Pallets)
.Cells(intCurrentRow, 2).Value = "No of Nights : " &
rs!NoOfNights & Space(6 - Len(rs!NoOfNights) + 3) & "@ £" & rs!CostPerNight
& " per Night"
intCurrentRow = intCurrentRow + 1
End If
If rs!NoOfDemurrageHRS > 0 And rs!CostPerDemurrageHR > 0 Then
'check first of each pair - starting with field 19 (No Of Pallets)
.Cells(intCurrentRow, 2).Value = "Demurrage Hrs : " &
rs!NoOfDemurrageHRS & Space(6 - Len(rs!NoOfDemurrageHRS) + 3) & "@ £" &
rs!CostPerDemurrageHR & " per Hour"
intCurrentRow = intCurrentRow + 1
End If
If rs!FuelSurcharge > 0 Then 'check first of each pair - starting
with field 19 (No Of Pallets)
.Cells(intCurrentRow, 2).Value = "Fuel Surcharge : £" &
rs!FuelSurcharge & Space(6 - Len(rs!FuelSurcharge) + 2) & "@ " &
rs!PercentageFuelSurcharge & "%"
intCurrentRow = intCurrentRow + 1
End If
rs.MoveNext
intCurrentRow = intCurrentRow + 1
Loop
rs.Close
End With
objExcel.ActiveWorkbook.SaveAs ("c:\Windows\Temp\Invoice - " &
Forms!frmPrintInvoices.txtInvoiceNo & ".xls") 'create the xls file
Exit_ExportToSpreadsheet:
If (Not objExcel Is Nothing) Then
objExcel.[Quit]
Set objExcel = Nothing
End If
Exit Sub
Err_ExportToSpreadsheet:
Select Case Err
Case 0
Resume Next
Case Else
MsgBox Err.Number & " " & Err.Description, vbCritical, "Error!"
Resume Exit_ExportToSpreadsheet
End Select
End Sub
Ken Snell (MVP) said:
Somewhere in the code that you did not post is one or more steps that are
creating new references to EXCEL because the step is not fully qualifying
all references to objects within EXCEL. To assist you, you need to post all
the code.
--
Ken Snell
<MS ACCESS MVP>
Pete said:
Re Office XP (no SP's)
I am using Access VBA (DAO) to generate a spreadsheet from some relevant
Access data like this:-
Set objExcel = CreateObject("Excel.Application")
...assign recordset values to relevant cells...
Then clear up with.
objExcel.ActiveWorkbook.SaveAs ("c:\Windows\Temp\Invoice - " &
Forms!frmPrintInvoices.txtInvoiceNo & ".xls")
If (Not objExcel Is Nothing) Then
objExcel.[Quit]
Set objExcel = Nothing
End If
End sub
The problem is that an Excel process is left running in memory (visible in
Task manager) when the procedure has completed successfully.
Is there a way to remove the Excel process completely from memory?
Many thanks.
