Hi,
I have some code written that creates and Excel Application, copies 3 recordsets (Each is a seperate report) into 3 different worksheets.
The code works fine the first time i run it but if I try to run the code again without closing the database i get a error message "91 - Object variable or with block variable not set".
The error happens at 4 locations within the code, the code is below and the line that causes the break is highlighted in [red]RED[/red].
I would be s grateful if someone could tell me what i have done wrong and how i could possily fix it.
Many Thanks
Hayden
Public Sub Export_Reports()
On Error GoTo errConfig
[green]'DELETE OLD DATA[/green]
DoCmd.RunSQL "DELETE tbl_Cost_Per_Car.* FROM tbl_Cost_Per_Car;"
DoCmd.RunSQL "DELETE tbl_Cost_Per_Country.* FROM tbl_Cost_Per_Country;"
DoCmd.RunSQL "DELETE tbl_Cost_Per_Supplier.* FROM tbl_Cost_Per_Supplier;"
[green]'APPEND NEW DATA[/green]
DoCmd.OpenQuery "qry_Cost_Per_Car"
DoCmd.OpenQuery "qry_Cost_Per_Country_Append"
DoCmd.OpenQuery "qry_Cost_Per_Supplier_Report_Append"
[green]'CHECK THAT ALL 3 TABLES HAVE INFORAMTION IN[/green]
If DCount("*", "tbl_Cost_Per_Car" = 0 Or DCount("*", "tbl_Cost_Per_Supplier" = 0 _
Or DCount("*", "tbl_Cost_Per_Country" = 0 Then
MsgBox "not all tables have inforamtion in. Please check that you have not missed any processes"
Exit Sub
End If
DoCmd.SetWarnings False
Set db = CurrentDb
Set rstSupplier = db.OpenRecordset("tbl_Cost_Per_Supplier"
Set rstCar = db.OpenRecordset("tbl_Cost_Per_Car"
Set rstCountry = db.OpenRecordset("tbl_Cost_Per_Country"
[green]'SET VARIABLES FOR EXPORT INTO SPREADSHEET WITH CALCUALTION DATA[/green]
With Forms![Import BaaN PFEP]
strDate = CStr(Format(Now, "dd-mm-yy")
strTime = CStr(Format(Now, "hh:nn")
intWeeklyBuild = !Weekly_Build
intMonthlyBuild = !Monthly_Build
strMinVol = CStr(Format(!Min_Trailer_Vol, "00.00%")
strMaxVol = CStr(Format(!Max_Trailer_Vol, "00.00%")
strProfit = CStr(Format((!ProffitCalc - 1), "00.00%")
strStart = CStr(Format(!calStart, "dd-mm-yy")
strEnd = CStr(Format(!calEnd, "dd-mm-yy")
strReference = !List32
strUser = GetLoginUserName [green]'Get windows user name[/green]
End With
GetFileName:
strFile = Trim(InputBox("Please enter the name you wish to save these reports as.", conAppName, strReference))
If IsNull(strFile) Or strFile = "" Then
msbbox "Please enter a reference for the file",,conAppName
GoTo GetFileName
End If
Set appXL = CreateObject("Excel.Application"
appXL.Workbooks.Add
With appXL
[green]'COPY NEW COST PER CAR DATA INTO SHEET1[/green]
.Range("B2".Value = "Start Date of Week"
.Range("B3".Value = "End Date of Week"
.Range("B4".Value = "Weekly Build"
.Range("B5".Value = "Monthly Build"
.Range("B6".Value = "Min Trailer Util (%)"
.Range("B7".Value = "Max Trailer Util (%)"
.Range("B8".Value = "Profit Margin"
.Range("F2".Value = "Date Report Created"
.Range("F3".Value = "Time Report Created"
.Range("F4".Value = "Created By"
.Range("D2".Value = strStart
.Range("D3".Value = strEnd
.Range("D4".Value = intWeeklyBuild
.Range("D5".Value = intMonthlyBuild
.Range("D6".Value = strMinVol
.Range("D7".Value = strMaxVol
.Range("D8".Value = strProfit
.Range("F2".Value = strDate
.Range("F3".Value = strTime
.Range("F4".Value = strUser
.Range("A11".Value = "VAT Region"
.Range("B11".Value = "Material Cost"
.Range("C11".Value = "Empties Cost"
.Range("D11".Value = "Volvo Cost"
.Range("E11".Value = "Total Cost"
.Range("F11".Value = "CPC"
.Range("A12".CopyFromRecordset rstCar
[red]ActiveSheet.Name = "Cost Per Car"[/red] [green] '** CODE BREAKS HERE ** [/green]
[green]'COPY NEW COST PER COUNTRY DATA INTO SHEET2[/green]
.Worksheets("Sheet2".Activate
.Range("A1".Value = "Country"
.Range("B1".Value = "LTL Groupage"
.Range("C1".Value = "FTLs"
.Range("D1".Value = "Empty LTL Groupage"
.Range("E1".Value = "Empty FTLs"
.Range("F1".Value = "Total Mateiral Cost"
.Range("G1".Value = "Total Empties Cost"
.Range("H1".Value = "Volvo_Cost"
.Range("I1".Value = "Total Cost"
.Range("J1".Value = "CPC"
.Range("A2".CopyFromRecordset rstCountry
[red]ActiveSheet.Name = "Cost Per Country"[/red][green] '** CODE BREAKS HERE ** [/green]
[green]'COPY NEW COST PER SUPPLIER DATA INTO SHEET2[/green]
.Worksheets("Sheet3".Activate
.Range("A1".Value = "Country"
.Range("B1".Value = "GSDB Code"
.Range("C1".Value = "Supplier"
.Range("D1".Value = "Country"
.Range("E1".Value = "LTL Groupage"
.Range("F1".Value = "FTLs"
.Range("G1".Value = "Empty LTL Groupage"
.Range("H1".Value = "Empty FTLs"
.Range("I1".Value = "Total Mateiral Cost"
.Range("J1".Value = "Total Empties Cost"
.Range("K1".Value = "Volvo Cost"
.Range("L1".Value = "Total Cost"
.Range("M1".Value = "CPC"
.Range("A2".CopyFromRecordset rstSupplier
[red]ActiveSheet.Name = "Cost Per Supplier"[/red][green] '** CODE BREAKS HERE ** [/green]
strFile = strFile & " - Baan.xls"
[red]ActiveSheet.SaveAs conAppFileLoc & strFile[/red][green] '** CODE BREAKS HERE ** [/green]
.Visible = True
End With
Set appXL = Nothing
Set wsXL = Nothing
DoCmd.SetWarnings True
MsgBox "The export of the reports is now complete", vbInformation, conAppName
Exit Sub
errConfig:
MsgBox Err.Number & " - " & Err.Description
Resume Next
End Sub
I have some code written that creates and Excel Application, copies 3 recordsets (Each is a seperate report) into 3 different worksheets.
The code works fine the first time i run it but if I try to run the code again without closing the database i get a error message "91 - Object variable or with block variable not set".
The error happens at 4 locations within the code, the code is below and the line that causes the break is highlighted in [red]RED[/red].
I would be s grateful if someone could tell me what i have done wrong and how i could possily fix it.
Many Thanks
Hayden
Public Sub Export_Reports()
On Error GoTo errConfig
[green]'DELETE OLD DATA[/green]
DoCmd.RunSQL "DELETE tbl_Cost_Per_Car.* FROM tbl_Cost_Per_Car;"
DoCmd.RunSQL "DELETE tbl_Cost_Per_Country.* FROM tbl_Cost_Per_Country;"
DoCmd.RunSQL "DELETE tbl_Cost_Per_Supplier.* FROM tbl_Cost_Per_Supplier;"
[green]'APPEND NEW DATA[/green]
DoCmd.OpenQuery "qry_Cost_Per_Car"
DoCmd.OpenQuery "qry_Cost_Per_Country_Append"
DoCmd.OpenQuery "qry_Cost_Per_Supplier_Report_Append"
[green]'CHECK THAT ALL 3 TABLES HAVE INFORAMTION IN[/green]
If DCount("*", "tbl_Cost_Per_Car" = 0 Or DCount("*", "tbl_Cost_Per_Supplier" = 0 _
Or DCount("*", "tbl_Cost_Per_Country" = 0 Then
MsgBox "not all tables have inforamtion in. Please check that you have not missed any processes"
Exit Sub
End If
DoCmd.SetWarnings False
Set db = CurrentDb
Set rstSupplier = db.OpenRecordset("tbl_Cost_Per_Supplier"
Set rstCar = db.OpenRecordset("tbl_Cost_Per_Car"
Set rstCountry = db.OpenRecordset("tbl_Cost_Per_Country"
[green]'SET VARIABLES FOR EXPORT INTO SPREADSHEET WITH CALCUALTION DATA[/green]
With Forms![Import BaaN PFEP]
strDate = CStr(Format(Now, "dd-mm-yy")
strTime = CStr(Format(Now, "hh:nn")
intWeeklyBuild = !Weekly_Build
intMonthlyBuild = !Monthly_Build
strMinVol = CStr(Format(!Min_Trailer_Vol, "00.00%")
strMaxVol = CStr(Format(!Max_Trailer_Vol, "00.00%")
strProfit = CStr(Format((!ProffitCalc - 1), "00.00%")
strStart = CStr(Format(!calStart, "dd-mm-yy")
strEnd = CStr(Format(!calEnd, "dd-mm-yy")
strReference = !List32
strUser = GetLoginUserName [green]'Get windows user name[/green]
End With
GetFileName:
strFile = Trim(InputBox("Please enter the name you wish to save these reports as.", conAppName, strReference))
If IsNull(strFile) Or strFile = "" Then
msbbox "Please enter a reference for the file",,conAppName
GoTo GetFileName
End If
Set appXL = CreateObject("Excel.Application"
appXL.Workbooks.Add
With appXL
[green]'COPY NEW COST PER CAR DATA INTO SHEET1[/green]
.Range("B2".Value = "Start Date of Week"
.Range("B3".Value = "End Date of Week"
.Range("B4".Value = "Weekly Build"
.Range("B5".Value = "Monthly Build"
.Range("B6".Value = "Min Trailer Util (%)"
.Range("B7".Value = "Max Trailer Util (%)"
.Range("B8".Value = "Profit Margin"
.Range("F2".Value = "Date Report Created"
.Range("F3".Value = "Time Report Created"
.Range("F4".Value = "Created By"
.Range("D2".Value = strStart
.Range("D3".Value = strEnd
.Range("D4".Value = intWeeklyBuild
.Range("D5".Value = intMonthlyBuild
.Range("D6".Value = strMinVol
.Range("D7".Value = strMaxVol
.Range("D8".Value = strProfit
.Range("F2".Value = strDate
.Range("F3".Value = strTime
.Range("F4".Value = strUser
.Range("A11".Value = "VAT Region"
.Range("B11".Value = "Material Cost"
.Range("C11".Value = "Empties Cost"
.Range("D11".Value = "Volvo Cost"
.Range("E11".Value = "Total Cost"
.Range("F11".Value = "CPC"
.Range("A12".CopyFromRecordset rstCar
[red]ActiveSheet.Name = "Cost Per Car"[/red] [green] '** CODE BREAKS HERE ** [/green]
[green]'COPY NEW COST PER COUNTRY DATA INTO SHEET2[/green]
.Worksheets("Sheet2".Activate
.Range("A1".Value = "Country"
.Range("B1".Value = "LTL Groupage"
.Range("C1".Value = "FTLs"
.Range("D1".Value = "Empty LTL Groupage"
.Range("E1".Value = "Empty FTLs"
.Range("F1".Value = "Total Mateiral Cost"
.Range("G1".Value = "Total Empties Cost"
.Range("H1".Value = "Volvo_Cost"
.Range("I1".Value = "Total Cost"
.Range("J1".Value = "CPC"
.Range("A2".CopyFromRecordset rstCountry
[red]ActiveSheet.Name = "Cost Per Country"[/red][green] '** CODE BREAKS HERE ** [/green]
[green]'COPY NEW COST PER SUPPLIER DATA INTO SHEET2[/green]
.Worksheets("Sheet3".Activate
.Range("A1".Value = "Country"
.Range("B1".Value = "GSDB Code"
.Range("C1".Value = "Supplier"
.Range("D1".Value = "Country"
.Range("E1".Value = "LTL Groupage"
.Range("F1".Value = "FTLs"
.Range("G1".Value = "Empty LTL Groupage"
.Range("H1".Value = "Empty FTLs"
.Range("I1".Value = "Total Mateiral Cost"
.Range("J1".Value = "Total Empties Cost"
.Range("K1".Value = "Volvo Cost"
.Range("L1".Value = "Total Cost"
.Range("M1".Value = "CPC"
.Range("A2".CopyFromRecordset rstSupplier
[red]ActiveSheet.Name = "Cost Per Supplier"[/red][green] '** CODE BREAKS HERE ** [/green]
strFile = strFile & " - Baan.xls"
[red]ActiveSheet.SaveAs conAppFileLoc & strFile[/red][green] '** CODE BREAKS HERE ** [/green]
.Visible = True
End With
Set appXL = Nothing
Set wsXL = Nothing
DoCmd.SetWarnings True
MsgBox "The export of the reports is now complete", vbInformation, conAppName
Exit Sub
errConfig:
MsgBox Err.Number & " - " & Err.Description
Resume Next
End Sub