Object variable or With block variable....

P

paul8304424

New member
Local time
Today, 08:12
Joined
Mar 21, 2012
Messages
5
Hi,
When I run the code below first time, it works fine but everytime I re-run it, it generates an "Object variable or With block variable not set error".
Keep trying to find the problem but running out of patience.:banghead:

Code: 
Private Sub cmdExpMore4Apps_Click()
Dim xlapp As Excel.Application
Dim xlwbk As Excel.Workbook
Dim xlwks As Excel.Worksheet
Dim dbs As DAO.Database
Dim rstSource As DAO.Recordset
Dim rstExport As DAO.Recordset
Dim rst As DAO.Recordset
Dim strFileName As String
Dim lastRow As Integer
'Set database variables
Set dbs = CurrentDb
Set rstSource = dbs.OpenRecordset("tblExpFieldNames")
Set rstExport = dbs.OpenRecordset("SELECT [Invoice Number], [Currency], [Value] FROM tblReceiptInvoices WHERE ([ReceiptBatchID] = " & [Forms]![frmBatchProcessing]![txtSelectedRecord] & " And [Invoice Number] <>'CNC' And [Invoice Number] Not Like 'NLA*');")
'Open Excel File and Format
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = True
Set xlwbk = xlapp.Workbooks.Add
Set xlwks = xlapp.Sheets("Sheet1")
'Set up row one of More4Apps format
With xlwks
        .Activate
        .Range("A1:F1").Select
    
    With Selection
       [B] .HorizontalAlignment = xlLeft 'Error highlights this line[/B]
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

When the error is generated and I hover over the xlwks variable it states "= Nothing" which seems odd given that it's declared at the beginning of the procedure and there is an
Code: 
 Set xlwks = Nothing
at the end of the procedure.

Thanks for your help and advice,
Paul
 
Think I've solved it.
I've replaced
Code: 
Set xlapp = CreateObject("Excel.Application")

With

Code: 
On Error Resume Next
        Set xlapp = GetObject(, "Excel.Application")
On Error GoTo 0
If xlapp Is Nothing Then
        Set xlapp = CreateObject("Excel.Application")
End If
and it seems to be working ok.
 
Hi Bob,
Here the whole procedure (less a huge amount of repetitive cell and text formatting).
The purpose of the proedure is to export a selected record and sub-record set to an excel template in a specific format template (More4Apps Oracle Receipts Wizard).
The data is stored as a header and lines, in different nested tables.

Code: 
Private Sub cmdExpMore4Apps_Click()
Dim xlapp As Excel.Application
Dim xlwbk As Excel.Workbook
Dim xlwks As Excel.Worksheet
Dim dbs As DAO.Database
Dim rstSource As DAO.Recordset
Dim rstExport As DAO.Recordset
Dim rst As DAO.Recordset
Dim strFileName As String
Dim lastRow As Integer
'Set database variables
Set dbs = CurrentDb
Set rstSource = dbs.OpenRecordset("tblExpFieldNames") 'excel format field names held in table with offset reference
Set rstExport = dbs.OpenRecordset("SELECT [Invoice Number], [Currency], [Value] FROM tblReceiptInvoices WHERE ([ReceiptBatchID] = " & [Forms]![frmBatchProcessing]![txtSelectedRecord] & " And [Invoice Number] <>'CNC' And [Invoice Number] Not Like 'NLA*');")
'Open Excel File and Format
On Error Resume Next
        Set xlapp = GetObject(, "Excel.Application")
On Error GoTo 0
If xlapp Is Nothing Then
        Set xlapp = CreateObject("Excel.Application")
End If
xlapp.Visible = True
Set xlwbk = xlapp.Workbooks.Add
Set xlwks = xlapp.ActiveWorkbook.Sheets("Sheet1")
'Set up row one of More4Apps format
With xlwks
        .Activate
        .Range("A1:F1").Select
 
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
 
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10040115
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("H1:AE1").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("AF1:AU1").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
 
End With
'Set up row two of More4Apps format
xlapp.ActiveSheet.Range("A2").Activate
'Loop field names into workbook
With rstSource
        .MoveFirst
        Do While Not .EOF
        intRC = Format((rstSource.Fields("Offset")), 0)
        ActiveCell.Offset(0, intRC).Value = rstSource.Fields("FieldName")
        rstSource.MoveNext
        Loop
End With
'Format Cells
With xlwks
 
                'Yellow headers
                Range("A2:F2").Select
                    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
 
 
    rstExport.MoveLast
    lastRow = rstExport.RecordCount + 2
    rstExport.MoveFirst
 
    Range("A3", "F" & lastRow).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    'Range fill with background colours
    Range("A3", "F" & lastRow).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = RGB(51, 204, 204)
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
       Range("A1").Value = "Upload Results"
       Range("H1").Value = "Receipts"
       Range("AF1").Value = "Descriptive Flexfields"
       Range("AW1").Value = "Invoice Application"
       Range("CI1").Value = "Invoice Adjustment"
 
 
 
Columns("A:CN").EntireColumn.AutoFit
 
End With
ActiveSheet.Columns("G").EntireColumn.ColumnWidth = 1
ActiveSheet.Columns("AV").EntireColumn.ColumnWidth = 1
ActiveSheet.Columns("CH").EntireColumn.ColumnWidth = 1
 
'Save Formatted file
strFileName = "IKEA_" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & "_" & DLookup("[Currency]", "tblUploadDocuments", "[Ocean Receipt Document] = '" & [Forms]![frmBatchProcessing]![txtPayDoc] & "'") & "_" & Format([Forms]![frmBatchProcessing]![frmSubformReceiptSummarise].Form.[Receipt Batch Date], "YYYYMMDD") & ".xls"
On Error GoTo ErrMakeFolders
        xlwbk.SaveAs FileName:="C:\More4Apps\IKEAFiles\" & strFileName & "", FileFormat:=56
On Error GoTo 0
'Insert Header Data
ActiveSheet.Range("A3").Select
With Selection
                .Offset(0, 7).Value = Me!txtPayDoc
                .Offset(0, 9).Value = Me!frmSubformReceiptSummarise.Form.[Bank Account]
                .Offset(0, 11).Value = Me!frmSubformReceiptSummarise.Form.[Receipt Number]
                .Offset(0, 13).Value = Me!frmSubformReceiptSummarise.Form.[Customer Name]
                .Offset(0, 14).Value = Me!frmSubformReceiptSummarise.Form.[Customer Number]
                .Offset(0, 16).Value = Format(Me!frmSubformReceiptSummarise.Form.[Receipt Batch Date], DateString)
                .Offset(0, 17).Value = Format(Me!frmSubformReceiptSummarise.Form.[Receipt Batch Date], DateString)
                .Offset(0, 18).Value = Format(Me!frmSubformReceiptSummarise.Form.[Receipt Batch Date], DateString)
                .Offset(0, 22).Value = Format(Me!frmSubformReceiptSummarise.Form.[Receipt Batch Date], DateString)
                .Offset(0, 23).Value = Me!frmSubformReceiptSummarise.Form.[Total Receipt Amount]
                .Offset(0, 27).Value = Me!frmSubformReceiptSummarise.Form.[Currency]
 
End With
'Insert Application Data
rstExport.MoveFirst
With rstExport
        xlwks.Range("BB3").Select
        Do While Not .EOF
                Selection.Offset(0, 0).Value = rstExport("Invoice Number")
                Selection.Offset(0, 1).Value = 1
                Selection.Offset(0, 5).Value = rstExport("Value")
                Selection.Offset(0, 27).Value = rstExport("Currency")
        .MoveNext
        Selection.Offset(1, 0).Select
        Loop
End With
 
ans = MsgBox("Archive Records?", vbSystemModal + vbYesNo, "Archive prompt")
If ans = vbYes Then
 
                'Change batch status
                Set rst = dbs.OpenRecordset("SELECT * FROM tblReceiptBatch WHERE [ReceiptBatchID]=" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & ";")
 
                rst.Edit
                    rst("Status") = "Batch Processed"
                    rst("Process point") = Now()
 
                rst.Update
 
 
                'Move processed items to archive
                DoCmd.OpenQuery "qryAddToArchive"
 
                'Delete processed items from active tables
                DoCmd.RunSQL "DELETE InvoiceRecordID, SBIFileID, ReceiptID, ReceiptBatchID, [Invoice Date], [Invoice Number], Currency, Value FROM tblReceiptInvoices WHERE (((tblReceiptInvoices.ReceiptBatchID)= " & [Forms].frmBatchProcessing.[txtSelectedRecord] & "));"
                DoCmd.RunSQL "DELETE [File ID], ReceiptID, [Receipt batch ID], [SBI filename], [SBI filepath], SBIfiletype, [SBI file last modified], [SBI file total] FROM tblReceiptFile WHERE (((tblReceiptFile.[Receipt batch ID])= " & [Forms]![frmBatchProcessing]![txtSelectedRecord] & "));"
                DoCmd.RunSQL "DELETE ReceiptID, [ReceiptBatch ID], [Customer Name], [Customer Number], [Receipt Currency], [Total Receipt Amount] FROM tblReceipt WHERE ((([ReceiptBatch ID])=" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & "));"
                DoCmd.RunSQL "DELETE ReceiptBatchID, Site, [Bank Account], [Receipt Batch Date], [Receipt Number], Currency, Status, [Load point], [Process point] FROM tblReceiptBatch WHERE (((ReceiptBatchID)=" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & "));"
End If
'Inform process completion
MsgBox "Batch ID" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & " processed."
Forms!frmBatchProcessing!txtSelectedRecord = ""
Me.Refresh
 
'xlDisplayAlerts = True
Set xlapp = Nothing
Set xlwbk = Nothing
Set xlwks = Nothing
'xlwbk.Save
'xlwbk.Close
'xlapp.Quit
Set rst = Nothing
Set rstSource = Nothing
Set rstExport = Nothing
dbs.Close
Exit Sub
'Error catcher if directories for save do not exist
ErrMakeFolders:
        MkDir ("C:\More4Apps")
        MkDir ("C:\More4Apps\IKEAfiles")
Resume Next
End Sub

Thanks again,
Paul
 
Well, actually all of the code might be necessary but here's several things in red which are not tied to the application object and hence would cause a problem (another hidden instance of Excel is created) and you have a HORRENDOUS number of places which should be fixed.

Code: 
Private Sub cmdExpMore4Apps_Click()
Dim xlapp As Excel.Application
Dim xlwbk As Excel.Workbook
Dim xlwks As Excel.Worksheet
Dim dbs As DAO.Database
Dim rstSource As DAO.Recordset
Dim rstExport As DAO.Recordset
Dim rst As DAO.Recordset
Dim strFileName As String
Dim lastRow As Integer
'Set database variables
Set dbs = CurrentDb
Set rstSource = dbs.OpenRecordset("tblExpFieldNames") 'excel format field names held in table with offset reference
Set rstExport = dbs.OpenRecordset("SELECT [Invoice Number], [Currency], [Value] FROM tblReceiptInvoices WHERE ([ReceiptBatchID] = " & [Forms]![frmBatchProcessing]![txtSelectedRecord] & " And [Invoice Number] <>'CNC' And [Invoice Number] Not Like 'NLA*');")
'Open Excel File and Format
On Error Resume Next
        Set xlapp = GetObject(, "Excel.Application")
On Error GoTo 0
If xlapp Is Nothing Then
        Set xlapp = CreateObject("Excel.Application")
End If
xlapp.Visible = True
Set xlwbk = xlapp.Workbooks.Add
Set xlwks = xlapp.ActiveWorkbook.Sheets("Sheet1")
'Set up row one of More4Apps format
With xlwks
        .Activate
        .Range("A1:F1").Select
 
    With [B][COLOR="Red"]Selection[/COLOR][/B]
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
 
    [COLOR="Red"][B]Selection[/B][/COLOR].Borders(xlDiagonalDown).LineStyle = xlNone
   [B][COLOR="red"] Selection[/COLOR][/B].Borders(xlDiagonalUp).LineStyle = xlNone
 
    With [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With [B][COLOR="red"]Selection[/COLOR][/B].Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10040115
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With [B][COLOR="red"]Selection[/COLOR][/B].Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    [B][COLOR="red"]Range[/COLOR][/B]("H1:AE1").Select
    With [B][COLOR="red"]Selection[/COLOR][/B]
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    [B][COLOR="red"]Selection[/COLOR][/B].Merge
    Range("AF1:AU1").Select
    With [B][COLOR="red"]Selection[/COLOR][/B]
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    [B][COLOR="red"]Selection[/COLOR][/B].Merge
 
End With
'Set up row two of More4Apps format
xlapp.ActiveSheet.Range("A2").Activate
'Loop field names into workbook
With rstSource
        .MoveFirst
        Do While Not .EOF
        intRC = Format((rstSource.Fields("Offset")), 0)
        [B][COLOR="red"]ActiveCell[/COLOR][/B].Offset(0, intRC).Value = rstSource.Fields("FieldName")
        rstSource.MoveNext
        Loop
End With
'Format Cells
With xlwks
 
                'Yellow headers
                [B][COLOR="red"]Range[/COLOR][/B]("A2:F2").Select
                    [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlDiagonalDown).LineStyle = xlNone
                    [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlDiagonalUp).LineStyle = xlNone
                    With [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
 
 
    rstExport.MoveLast
    lastRow = rstExport.RecordCount + 2
    rstExport.MoveFirst
 
    [B][COLOR="red"]Range[/COLOR][/B]("A3", "F" & lastRow).Select
    [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlDiagonalDown).LineStyle = xlNone
    [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlDiagonalUp).LineStyle = xlNone
    With [B][COLOR="red"]Selection[/COLOR][/B].Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    'Range fill with background colours
    [B][COLOR="red"]Range[/COLOR][/B]("A3", "F" & lastRow).Select
    With [B][COLOR="red"]Selection[/COLOR][/B].Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = RGB(51, 204, 204)
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
       [B][COLOR="red"]Range[/COLOR][/B]("A1").Value = "Upload Results"
       [B][COLOR="red"]Range[/COLOR][/B]("H1").Value = "Receipts"
       [B][COLOR="red"]Range[/COLOR][/B]("AF1").Value = "Descriptive Flexfields"
       [B][COLOR="red"]Range[/COLOR][/B]("AW1").Value = "Invoice Application"
       [B][COLOR="red"]Range[/COLOR][/B]("CI1").Value = "Invoice Adjustment"
 
 
 
Columns("A:CN").EntireColumn.AutoFit
 
End With
[B][COLOR="red"]ActiveSheet[/COLOR][/B].Columns("G").EntireColumn.ColumnWidth = 1
[B][COLOR="red"]ActiveSheet[/COLOR][/B].Columns("AV").EntireColumn.ColumnWidth = 1
[B][COLOR="red"]ActiveSheet[/COLOR][/B].Columns("CH").EntireColumn.ColumnWidth = 1
 
'Save Formatted file
strFileName = "IKEA_" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & "_" & DLookup("[Currency]", "tblUploadDocuments", "[Ocean Receipt Document] = '" & [Forms]![frmBatchProcessing]![txtPayDoc] & "'") & "_" & Format([Forms]![frmBatchProcessing]![frmSubformReceiptSummarise].Form.[Receipt Batch Date], "YYYYMMDD") & ".xls"
On Error GoTo ErrMakeFolders
        xlwbk.SaveAs FileName:="C:\More4Apps\IKEAFiles\" & strFileName & "", FileFormat:=56
On Error GoTo 0
'Insert Header Data
[B][COLOR="red"]ActiveSheet[/COLOR][/B].Range("A3").Select
With [B][COLOR="red"]Selection[/COLOR][/B]
                .Offset(0, 7).Value = Me!txtPayDoc
                .Offset(0, 9).Value = Me!frmSubformReceiptSummarise.Form.[Bank Account]
                .Offset(0, 11).Value = Me!frmSubformReceiptSummarise.Form.[Receipt Number]
                .Offset(0, 13).Value = Me!frmSubformReceiptSummarise.Form.[Customer Name]
                .Offset(0, 14).Value = Me!frmSubformReceiptSummarise.Form.[Customer Number]
                .Offset(0, 16).Value = Format(Me!frmSubformReceiptSummarise.Form.[Receipt Batch Date], DateString)
                .Offset(0, 17).Value = Format(Me!frmSubformReceiptSummarise.Form.[Receipt Batch Date], DateString)
                .Offset(0, 18).Value = Format(Me!frmSubformReceiptSummarise.Form.[Receipt Batch Date], DateString)
                .Offset(0, 22).Value = Format(Me!frmSubformReceiptSummarise.Form.[Receipt Batch Date], DateString)
                .Offset(0, 23).Value = Me!frmSubformReceiptSummarise.Form.[Total Receipt Amount]
                .Offset(0, 27).Value = Me!frmSubformReceiptSummarise.Form.[Currency]
 
End With
'Insert Application Data
rstExport.MoveFirst
With rstExport
        xlwks.Range("BB3").Select
        Do While Not .EOF
                [B][COLOR="red"]Selection[/COLOR][/B].Offset(0, 0).Value = rstExport("Invoice Number")
                [B][COLOR="red"]Selection[/COLOR][/B].Offset(0, 1).Value = 1
                [B][COLOR="red"]Selection[/COLOR][/B].Offset(0, 5).Value = rstExport("Value")
                [B][COLOR="red"]Selection[/COLOR][/B].Offset(0, 27).Value = rstExport("Currency")
        .MoveNext
        [B][COLOR="red"]Selection[/COLOR][/B].Offset(1, 0).Select
        Loop
End With
 
ans = MsgBox("Archive Records?", vbSystemModal + vbYesNo, "Archive prompt")
If ans = vbYes Then
 
                'Change batch status
                Set rst = dbs.OpenRecordset("SELECT * FROM tblReceiptBatch WHERE [ReceiptBatchID]=" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & ";")
 
                rst.Edit
                    rst("Status") = "Batch Processed"
                    rst("Process point") = Now()
 
                rst.Update
 
 
                'Move processed items to archive
                DoCmd.OpenQuery "qryAddToArchive"
 
                'Delete processed items from active tables
                DoCmd.RunSQL "DELETE InvoiceRecordID, SBIFileID, ReceiptID, ReceiptBatchID, [Invoice Date], [Invoice Number], Currency, Value FROM tblReceiptInvoices WHERE (((tblReceiptInvoices.ReceiptBatchID)= " & [Forms].frmBatchProcessing.[txtSelectedRecord] & "));"
                DoCmd.RunSQL "DELETE [File ID], ReceiptID, [Receipt batch ID], [SBI filename], [SBI filepath], SBIfiletype, [SBI file last modified], [SBI file total] FROM tblReceiptFile WHERE (((tblReceiptFile.[Receipt batch ID])= " & [Forms]![frmBatchProcessing]![txtSelectedRecord] & "));"
                DoCmd.RunSQL "DELETE ReceiptID, [ReceiptBatch ID], [Customer Name], [Customer Number], [Receipt Currency], [Total Receipt Amount] FROM tblReceipt WHERE ((([ReceiptBatch ID])=" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & "));"
                DoCmd.RunSQL "DELETE ReceiptBatchID, Site, [Bank Account], [Receipt Batch Date], [Receipt Number], Currency, Status, [Load point], [Process point] FROM tblReceiptBatch WHERE (((ReceiptBatchID)=" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & "));"
End If
'Inform process completion
MsgBox "Batch ID" & [Forms]![frmBatchProcessing]![txtSelectedRecord] & " processed."
Forms!frmBatchProcessing!txtSelectedRecord = ""
Me.Refresh
 
'xlDisplayAlerts = True
Set xlapp = Nothing
Set xlwbk = Nothing
Set xlwks = Nothing
'xlwbk.Save
'xlwbk.Close
'xlapp.Quit
Set rst = Nothing
Set rstSource = Nothing
Set rstExport = Nothing
dbs.Close
Exit Sub
'Error catcher if directories for save do not exist
ErrMakeFolders:
        MkDir ("C:\More4Apps")
        MkDir ("C:\More4Apps\IKEAfiles")
Resume Next
End Sub

Any of the RANGE should be xlwks.Range(....etc.

And any of the SELECTION should be xlapp.Selection...etc.
 
You must log in or register to reply here.

Similar threads

M
Solved Object variable or with block variable not set
Replies
7
Views
1,705
theDBguy
theDBguy
M
Solved Object variable or With block variable not set Error
Replies
9
Views
6,239
Momma
M
D
Solved Creating Excel Files from Access
Replies
9
Views
1,420
arnelgp
arnelgp
L
Solved Error number :91 = Object variable or With variable not set
Replies
6
Views
1,497
Leo_Polla_Psemata
L
J
Help with Email VBA
Replies
4
Views
1,148
Gasman
Gasman

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom