_Global References Nightmare - MS Access & Excel VBA 3

[SBelyea]

Hey everyone -

As always, thanks in advance for any help or insight tek-tips and its community can provide me.

First the problem, then some background. When running the code below, I will get a _Global reference error every other time.

Background: One of the functions of my Access database is to export the results of a query to an Excel spreadsheet, and then format the Excel spreadsheet properly. I am using the DoCmd.TransferSpreadsheet command to accomplish this - no problems there.

The difficulty lies in (I believe):
1) Formatting the spreadsheet: I originally recorded macros in excel, and then dropped them into Access' VBA. As I said, the entire script runs perfectly fine the first time, but the second time I run it I receive an error at the very first "Range(...)" line.

2)Somehow having multiple copies of Excel open: despite using Excel.Application.Quit, Excel remains open after the script is run. Repeated running of the script results in repeated Excel instances being open.

* Code at end of post

I'd really appreciate any help or insight that is offered - I've spent the better part of two days trying to fix this problem, and am really just banging my head against the wall at this point.

Thanks in advance,

sbelyea

Public Function Create23()
    
    Dim objExcel As Excel.Application
    Dim excelPath
    Dim currentWorkSheet
    Dim objSheet As Object
    Dim objRange As Object
    Dim stDocName As String

    stDocName = "MyQuery"
    
    DoCmd.OpenQuery stDocName, acNormal, acEdit
    
    DoCmd.Close acQuery, "MyQuery", acSaveYes
    
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "MyQuery", "C:\MyQuery.xls", True
    
    excelPath = "C:\MyQuery.xls"
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    
    objExcel.DisplayAlerts = 0
    
    objExcel.Workbooks.Open excelPath, False, False
    
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
    'objSheet.Name = "MyQuery"
    
    objSheet.Cells(1, 3).Value = "MyQuery #"
    objSheet.Rows(1).Font.Bold = True
    
    ' Moves data down a row
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A2").Select
    ActiveSheet.Paste
    
    ' Selects "######" column and paints it yellow
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Interior.ColorIndex = 6
    ' Selects "#######" column and paints it grey
    Range("B2").Select
    Selection.Interior.ColorIndex = 48
    ' Selects remaining column heads and paints them blue
    Range("C2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Interior.ColorIndex = 42

    ' Adds a cell called "Notes"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "Notes"
    With ActiveCell.Characters(Start:=1, Length:=5).Font
        .Name = "MS Sans Serif"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    ' Removes the background color for cell L5 (Notes)
    Range("K2").Select
    Selection.Interior.ColorIndex = xlNone

    ' Puts a title above the data, adds current date
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "MyQuery List"
    Range("E1").Select
    With Selection
        .HorizontalAlignment = xlLeft
    End With
    ActiveCell.Value = Format(Now, "mmm dd, yyyy")
    Selection.NumberFormat = "mmm dd, yyyy"

    ' Changes all the column widths
    Columns("A:A").ColumnWidth = 4
    Columns("B:B").ColumnWidth = 4
    Columns("C:C").ColumnWidth = 6.5
    Columns("D:D").ColumnWidth = 20
    Columns("E:E").ColumnWidth = 13
    Columns("F:F").ColumnWidth = 9
    Columns("G:G").ColumnWidth = 8
    Columns("H:H").ColumnWidth = 8
    Columns("I:I").ColumnWidth = 10
    Columns("J:J").ColumnWidth = 9.14
    Columns("K:K").ColumnWidth = 23

    ' Sets all cells to Word Wrap
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    ' Changes all of the header columns to be center aligned
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    ' Changes data in H6:K9 to be center aligned
    Range("G3:J3").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    ' Makes the font Times New Roman
    Cells.Select
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    ' Creates borders around and within the data
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
    ' Change Print Layout to Landscape
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&A"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P"
        .RightFooter = ""
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    
    'Set objSheet = Nothing
    'Set objRange = Nothing
    'Set objExcel = Nothing
      
    Excel.Application.ActiveWorkbook.SaveAs excelPath
    
End Function

 

[PHV]

You have to full qualify ALL your excel objects, eg:
[!]objSheet.[/!]Range("A1").Select

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[SBelyea]

Hi PHV, thanks for the heads up! I'm still trying to wrap my head around the excel object model, so please bear with me..

I went through and added "objSheet." in front of the first set of "Range" lines - this seems to work fine, and I don't get an error on those the second time I run it.

The problem I'm currently encountering is the with the following line:

Selection.Cut

, which is preceded by

' Moves data down a row
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

I receive a Run Time Error '91': Object Variable or With block variable not set. I'm guessing that means I'm not referencing it right (although it runs fine the first time), but I'm not sure what the proper reference is for the Selection.Cut command.

On a side note, is there a detailed flowchart of the Excel object model (I know the MSDN network has one, but I was hoping to find something that lists all of the attributes, etc. down the line (e.g. Excel.Application.Workbooks.Worksheets...)).

Thanks in advance!

 

[bubba100]

Replace this--Excel.Application.ActiveWorkbook.SaveAs excelPath

with

objExcel.Application.ActiveWorkbook.Save
objExcel.Application.Quit

 

[SkipVought]

I went through and added "objSheet." in front of the first set of "Range" lines ...

...and why not be consistent?

Dim rng as range
' Moves data down a row
    with [b]objSheet[/b]
       Set rng = .Range(.Cells(1,1), .Cells(1,1).end(xltoright))
       .range(rng, rng.end(xldown)).cut
    end with

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SBelyea]

Skip, thanks for the clarification!

Most of the code in this function was created by recording macros in Excel, and then plugging the resulting code into this function (which is probably why I'm having so many problems). I'm currently going through my code and trying to apply the method you demonstrated above.

 

[SBelyea]

Skip, Bubba and PHV -

Thanks for all of your help on this. With the knowledge from PHV that I had to qualify all of my ojects and the examples of bubba and Skip, I've been able to fix my code!

I'm quite a babe in the woods when it comes to VBA, but this has been a terrific learning experience for me. Between using "With...End With" statements and setting variables As Range, I feel like I've added to my knowledge on this subject.

Thanks again!

-sbelyea

 

[SkipVought]

sbelyea,

Glad to help. Glad to see how eager you are to improve yourself.


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]