Must Hit Restart else "Object variable or with block variable not set" (Access --> Excel -->macro)

[bravura]

Tried all over the intenet to figure out this one.

What i am doing is i have a command button on Access Form. On Click [Event Procedure] calls a macro (module). Macro calls a query and exports to excel. Macro then runs on the worksheet. After i run this one time, for all future times i must manually press the reset button.

Dim shta As Worksheet <-- also tried as Excel.Worksheet
...

set shta = ActiveSheet
lastrow = shta.Cells(shta.Rows.Count, "A").End(xlUp).Row <--errors out. I tried removing the shta. from and still it gives me new error at this line.

...

Exit Procedure:
....
If Not shta Is Nothing Then Set shta = Nothing <--tried this too
....
Exit Sub



....

FYI. i skipped over this code and when got to line Sheets.Add.Name = "n": resulted in 1004 Application-defined or object-defined error.

 

[Russell Hauf]

I think you aren't getting responses due to a lack of information. How is lastrow defined? Any chance you can post more of the code? Also, if you use the code tags it easily separates code from non-code. (Look for the # sign).

 

[mrmmickle1]

I used this code to export an Access query to Excel, Save the Workbook in a temporary directory, email the file, then delete the file. You should be able to modify the code by changing the query name and file path name. Once this is done just comment out all of the stuff about the email...

[COLOR=#0000ff]Option Compare Database[/COLOR]
[COLOR=#0000ff]Option Explicit[/COLOR]
[COLOR=#008000]'=========================================================================='[/COLOR]
[COLOR=#008000]'Module Name: modExportData                                                '[/COLOR]
[COLOR=#008000]'Module Type: Code Module                                                  '[/COLOR]
[COLOR=#008000]'Purpose    : Export Access Query to Excel and then Email Workbook         '[/COLOR]
[COLOR=#008000]'=========================================================================='[/COLOR]
[COLOR=#008000]'Author     : Matt Mickle                                                  '[/COLOR]
[COLOR=#008000]'Date       : 22 February 2015                                             '[/COLOR]
[COLOR=#008000]'=========================================================================='[/COLOR]
[COLOR=#008000]'For this VBA Code to work you need to reference                           '[/COLOR]
[COLOR=#008000]'Microsoft Outlook XX.X Object Library                                     '[/COLOR]
[COLOR=#008000]'Microsoft Excel XX.X Object Library                                       '[/COLOR]
[COLOR=#008000]'=========================================================================='[/COLOR]
[COLOR=#0000ff]Sub [/COLOR]GetQueryInExcel()
   
   [COLOR=#0000ff] Dim[/COLOR] xlApp               [COLOR=#0000ff]As [/COLOR]Excel.Application
    [COLOR=#0000ff]Dim[/COLOR] rstDb               [COLOR=#0000ff]As[/COLOR] Recordset
 [COLOR=#0000ff]   Dim[/COLOR] conDb               [COLOR=#0000ff]As[/COLOR] Database
[COLOR=#0000ff]    Dim[/COLOR] xlWbkNew          [COLOR=#0000ff]  As[/COLOR] Workbook
   [COLOR=#0000ff] Dim[/COLOR] OutApp             [COLOR=#0000ff] As Object[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] OutMail     [COLOR=#0000ff]        As Object[/COLOR]
  [COLOR=#0000ff]  Dim [/COLOR]TempFilePath      [COLOR=#0000ff]  As String[/COLOR]
[COLOR=#0000ff]    Dim [/COLOR]TempFileName       [COLOR=#0000ff] As String[/COLOR]
  [COLOR=#0000ff]  Dim[/COLOR] WBName          [COLOR=#0000ff]    As String[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] lngLoop            [COLOR=#0000ff] As Long[/COLOR]
[COLOR=#0000ff]  [/COLOR]
[COLOR=#0000ff]    Const[/COLOR] strQryName      [COLOR=#0000ff]  As String [/COLOR]= "LowInventory" [COLOR=#008000]'<---Defines Query Name[/COLOR]
      
[COLOR=#0000ff]    On Error GoTo[/COLOR] ErrHandler
    
[COLOR=#0000ff]    Set[/COLOR] conDb = CurrentDb()
[COLOR=#0000ff]    Set[/COLOR] OutApp = CreateObject("Outlook.Application")
  [COLOR=#0000ff]  Set[/COLOR] OutMail = OutApp.CreateItem(0)
  [COLOR=#0000ff]  Set[/COLOR] rstDb = conDb.OpenRecordset(strQryName)[COLOR=#008000] 'Opens the Query LowInventory[/COLOR]
    
   [COLOR=#0000ff] If[/COLOR] rstDb.RecordCount > 0 [COLOR=#0000ff]Then[/COLOR]
        rstDb.MoveLast
        rstDb.MoveFirst
        [COLOR=#0000ff]Set[/COLOR] xlApp = CreateObject("Excel.Application")
      [COLOR=#0000ff]  Set [/COLOR]xlWbkNew = xlApp.Workbooks.Add(1)
       
       [COLOR=#0000ff] With[/COLOR] xlWbkNew.Worksheets(1)
        [COLOR=#0000ff]    For[/COLOR] lngLoop = 0 [COLOR=#0000ff]To [/COLOR]rstDb.Fields.Count - 1
                .Range("A1").Offset(, lngLoop).Value = rstDb.Fields(lngLoop).Name [COLOR=#008000] 'Get Header Fields[/COLOR]
        [COLOR=#0000ff]    Next[/COLOR] lngLoop
            .Range("A1").Offset(1, 0).CopyFromRecordset rstDb[COLOR=#008000] 'Print All Data in Query to Worksheet[/COLOR]
[COLOR=#0000ff]        End With[/COLOR]
[COLOR=#ff0000]        
        'Change this section to accomodate your needs[/COLOR]
        xlWbkNew.Worksheets(1).Name = "InventoryReport" [COLOR=#008000]'Name Worksheet[/COLOR]
        TempFilePath = Environ$("temp") & "\" [COLOR=#008000]'This defines the filepath ---> C:\Users\username\AppData\Local\Temp[/COLOR]
        TempFileName = "FD_Inventory Report_" & Format(Now, "MM.DD.YYYY h.mm AM/PM") & ".xlsx" [COLOR=#008000]'Name File with TimeStamp[/COLOR]
        xlWbkNew.SaveAs TempFilePath & TempFileName [COLOR=#008000]'Save file in Temporary Directory[/COLOR]
        
 [COLOR=#0000ff]   End If[/COLOR]
[COLOR=#ff0000]    'Comment this section out[/COLOR]
[COLOR=#008000]    'Email Workbook to people[/COLOR]
[COLOR=#008000]    'With OutMail[/COLOR]
[COLOR=#008000]        '.To = "YourName@Email.Com"[/COLOR]
[COLOR=#008000]        '.CC = ""[/COLOR]
[COLOR=#008000]        '.BCC = ""[/COLOR]
[COLOR=#008000]        '.Subject = "This is the Subject line"[/COLOR]
[COLOR=#008000]        '.Body = "This is the email body"  'Use "Blah Blah Blah" & Chr(13) & "This is another line"[/COLOR]
[COLOR=#008000]        '.Attachments.Add TempFilePath & TempFileName[/COLOR]
[COLOR=#008000]        '.Send[/COLOR]
[COLOR=#008000]    'End With[/COLOR]
    
[COLOR=#008000]    'Close WorkBook and DB Connections[/COLOR]
    rstDb.Close
    conDb.Close
    xlWbkNew.Close [COLOR=#0000ff]True[/COLOR]
    
[COLOR=#008000]    'Delete the Temporary File & Clear All Variables[/COLOR]
    Kill TempFilePath & TempFileName
  [COLOR=#0000ff]  Set [/COLOR]rstDb = [COLOR=#0000ff]Nothing[/COLOR]
   [COLOR=#0000ff] Set[/COLOR] conDb = [COLOR=#0000ff]Nothing[/COLOR]
   [COLOR=#0000ff] Set[/COLOR] xlApp = [COLOR=#0000ff]Nothing[/COLOR]
   [COLOR=#0000ff] Set [/COLOR]xlWbkNew =[COLOR=#0000ff] Nothing[/COLOR]
 [COLOR=#0000ff]   Set [/COLOR]OutMail = [COLOR=#0000ff]Nothing[/COLOR]
 [COLOR=#0000ff]   Set[/COLOR] OutApp = [COLOR=#0000ff]Nothing[/COLOR]
    lngLoop = [COLOR=#0000ff]Empty[/COLOR]
    TempFilePath = vbNullString
    TempFileName = vbNullString
    
    MsgBox "Inventory Report was emailed successfully!", vbInformation, "Inventory Report"
    
[COLOR=#0000ff]    Exit Sub[/COLOR]
    
ErrHandler:
MsgBox "An error has occured.  Please close this file and then" _
        & Chr(13) & "Reopen the file.  If the problem persists please" _
        & Chr(13) & " contact the file administrator." _
        & Chr(13) & Chr(13) & "Error Number:- " & Err.Number _
        & Chr(13) & "Description:- " & Err.Description _
        , vbCritical, "Error Handler"
        
    Kill TempFilePath & TempFileName
    [COLOR=#0000ff]Set[/COLOR] rstDb = [COLOR=#0000ff]Nothing[/COLOR]
  [COLOR=#0000ff]  Set[/COLOR] conDb = [COLOR=#0000ff]Nothing[/COLOR]
  [COLOR=#0000ff]  Set[/COLOR] xlApp = [COLOR=#0000ff]Nothing[/COLOR]
[COLOR=#0000ff]    Set[/COLOR] xlWbkNew = [COLOR=#0000ff]Nothing[/COLOR]
  [COLOR=#0000ff]  Set [/COLOR]OutMail = [COLOR=#0000ff]Nothing[/COLOR]
    [COLOR=#0000ff]Set[/COLOR] OutApp = [COLOR=#0000ff]Nothing[/COLOR]
    lngLoop = [COLOR=#0000ff]Empty[/COLOR]
    TempFilePath = vbNullString
    TempFileName = vbNullString


[COLOR=#0000ff]End Sub[/COLOR]

 

[bravura]

Sub Reports(intReportType)

Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim lastrow As Integer
Dim lastrowa As Integer
Dim lastcol As Integer
Dim shta As Worksheet
Dim newsht As Worksheet
Dim ReportType As String
Dim blnError As Boolean


On Error GoTo EH

[Form_Booking Matrix].lblReportStatus.Visible = True

Select Case intReportType

Case 0
ReportType = "Eqp"
strQueryName = "qryCntrReqs"
strFileName = "EquipReqs"


DoCmd.OutputTo acOutputQuery, strQueryName, "Microsoft Excel", _
"\\ server\...\ & strFileName & ".xls", False

Set mobjexcel = CreateObject("Excel.Application")

mobjexcel.Application.Visible = True

mobjexcel.Application.Workbooks.Open "\\server\...\ & strFileName & ".xls"

Set shta = ActiveSheet
a = 1
c = 1

lastrowa = shta.Cells(shta.Rows.Count, "A").End(xlUp).Row
lastrow = shta.Cells(shta.Rows.Count, "B").End(xlUp).Row
If lastrow < lastrowa Then lastrow = lastrowa ' because TL report has booking number col B and Col A may be blank.
lastcol = shta.Cells(1, shta.Columns.Count).End(xlToLeft).Column

...
...


End Select


Exit_Procedure:

If blnError = False Then
mobjexcel.Application.Workbooks(strFileName & ".xls").Save
End If

If Not mobjexcel Is Nothing Then Set mobjexcel = Nothing

[Form_Booking Matrix].lblReportStatus.Visible = False

If blnError = True Then
MsgBox "Report failed, please close and restart Access"
Else
MsgBox "Report has been completed."
End If

Exit Sub

EH:
If Err.Number = 2302 Then
If vbCancel = MsgBox("Excel file " & strFileName & ".xls" & " may still be open." & vbCrLf & _
"Please close this file before continuing or hit cancel", vbOKCancel) Then
[Form_Booking Matrix].lblReportStatus.Visible = False
Exit Sub
Else
Resume
End If
End If
MsgBox Err.Number & " - " & Err.Description
blnError = True
Resume Exit_Procedure

End Sub

 

[Russell Hauf]

Ahh...you are running this from Access. I think that what you need is this:

Set shta = mobjExcel.ActiveSheet

 

[bravura]

Thanks a LOT, Russel. it's working better, but every time i refer to Sheets, i have to add the mobjExcel. Is there something else i can do? I don't have a prob adding mobjExcel. everywhere if it runs ok.:

mobjexcel.Sheets.Add.Name = "ARRIVED"
shta.Rows(1).Copy Destination:=mobjexcel.Sheets("ARRIVED").Rows(1)
With mobjexcel.Sheets("ARRIVED").Tab ' sand
.ThemeColor = xlThemeColorAccent2
.TintAndShade = -0.249977111117893
End With

mobjexcel.Sheets.Add.Name = "ON_THE_WATER"
shta.Rows(1).Copy Destination:=mobjexcel.Sheets("ON_THE_WATER").Rows(1)
With mobjexcel.Sheets("ON_THE_WATER").Tab ' blue
.ThemeColor = xlThemeColorAccent5
.TintAndShade = -0.249977111117893
End With

 

[Russell Hauf]

I'd add a Workbook object, and use that. About the same as mobjExcel though.

You're most welcome, glad it helped!

 

[Russell Hauf]

Also, you could use another layer of With. Something like this:

With mobjExcel
    .Sheets.Add.Name = "ARRIVED"
    shta.Rows(1).Copy Destination:=mobjExcel.Sheets("ARRIVED").Rows(1)
    With .Sheets("ARRIVED").Tab ' sand
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = -0.249977111117893
    End With
    
    .Sheets.Add.Name = "ON_THE_WATER"
    shta.Rows(1).Copy Destination:=mobjExcel.Sheets("ON_THE_WATER").Rows(1)
    With .Sheets("ON_THE_WATER").Tab ' blue
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = -0.249977111117893
    End With
End With

Again, I'd probably use a Workbook object instead of Excel...but I'm just picky like that.

Happy Friday,

 

[bravura]

thanks a lot for the help. it's working - just have to do this for several called subs as well. but if it works, who cares.