error 1004 Method Range of Object_Global failed

[Racquet]

I haven't figured out the problem here, perhaps someone can explain where I went wrong.

I have a simple piece of vba code in Access that opens an Excel file, copies the results from a select query to cell E6 in the Excel worksheet, then copies the data from a range starting at cell E6 and does a copy/paste/special/transpose to realign the data into a horizontal range starting at cell F5.

The first time that I run the code, I get a Run-Time error "1004" Method Range of object_Global failed.

If I start the vba code over again (having closed Excel), the code runs just fine, the Excel file is opened, data is copied to cell E6, data is transposed to cell F5, and the Excel file is saved as "Test1.xls." Excel is then closed. Inspection of the Excel file that was created shows that the result was exactly as intended.

I have tried this over and over again. First time, I get an error, next time, it runs fine. Baffling.

Here is my code:

Sub EvaluateProblem() 'This code copies data to Excel and then does a Copy/Paste/Special/Transpose
 
Dim rst As DAO.Recordset
Dim Xl As Excel.Application
Dim XlBook As Excel.Workbook
Dim Xlsheet As Excel.Worksheet
Dim MySheetPath As String
 
Set Xl = New Excel.Application
Xl.Visible = True
 
' Tell it location of actual Excel file
MySheetPath = "C:\Access Development\July 26, 2010 Folder\test.xls"
 
Set XlBook = Xl.Workbooks.Open(MySheetPath)
 
' Make sure excel is visible on the screen
XlBook.Windows(1).Visible = True
 
' Define the sheet in the Workbook as XlSheet
Set Xlsheet = XlBook.Worksheets("Sheet2") ' Names the sheet to which data is copied (Sheet2)
 
' Copies the data from Query 100A to to Cell E6. Query100A is a Select query with two values.
 
Set rst = CurrentDb.OpenRecordset("Query100A") ' References Query100A
Xlsheet.Range("e6").CopyFromRecordset rst ' Copies the data from Query 100A to to Cell E6
rst.Close
Set rst = Nothing
 
With Xl.Application.ActiveWorkbook.ActiveSheet
 
Range("e6").Select
 
' Code to test whether the data is one cell only, or more than one cell
 
If IsEmpty(ActiveCell.Offset(-1, 0)) Then
Selection.Copy
Range("F5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
 
Else
Range(Selection, Selection.End(xlDown)).Select "Selects the entire range"
Selection.Copy
Range("F5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
 
End If
 
End With
 
' Close the Excel Workbook
' Save (and disconnect from) the Workbook
XlBook.SaveAs "C:\Access Development\July 26, 2010 Folder\Test1.xls"
XlBook.Close
 
' Clean up and end with Excel worksheet NOT visible on the screen
 
Set XlBook = Nothing
Set Xlsheet = Nothing
 
Xl.Quit
Set Xl = Nothing
 
End Sub

If someone can spot my error, I would surely appreciate it. I am just about finished up with resolving the technical problems with my application.

 

[Racquet]

I finally put everything together in one code module. I am using Access 2003. The VBA code opens an Excel worksheet, runs an Access query within a loop, inserts data from the Access query into the worksheet, then saves the file with a name consistent with the data contained in the Excel file. The code then loops through the database saving Excel files consistent with the data contained in the file until the Access application has run the query for every organization in the database and has created a Excel file for every organization.

The Excel file that is open has an On_Open event, however the Access VBA code has a piece of code that diables the on_open event.

Sub August_18_2010_Completed_Code() 'This code loops through organizations and adds data to an existing Excel file

    Dim MyRecordsetcriteria As ADODB.Recordset
    Dim rst As Recordset
    Dim Newrst As DAO.Recordset
    
    Dim Xl As Excel.Application
    Dim XlBook As Excel.Workbook
    Dim Xlsheet As Excel.Worksheet
    Dim MySheetPath As String
    
    Dim CellRange1 As Excel.Range
    Dim CellRange2 As Excel.Range
    Dim CellRange3 As Excel.Range

    Set Xl = New Excel.Application
    Xl.Visible = True

    ' Tell it location of actual Excel file
    MySheetPath = "C:\Access Development\July 26, 2010 Folder\test.xls"

    Set MyRecordsetcriteria = New ADODB.Recordset
    MyRecordsetcriteria.Open "SELECT distinct QuerySelectQuery.Org FROM QuerySelectQuery", CurrentProject.Connection

'           Starts a Do Loop
    Do While Not MyRecordsetcriteria.EOF
      
        Xl.Application.EnableEvents = False
'           Open Excel and the workbook
        Set XlBook = Xl.Workbooks.Open(MySheetPath)

 '      Make sure excel is visible on the screen
        XlBook.Windows(1).Visible = True

 '          Define the sheet in the Workbook as XlSheet
        Set Xlsheet = XlBook.Worksheets("Sheet2") ' Names the sheet to which data is copied (Sheet2)'

 '          Code to populate a temporary table which is used in Query 100 to select data that is to be saved in an Excel file
        CurrentDb.Execute "Delete * From tblOrgSelect"
        
 '          Code to populate tblOrgSelect with distinct organization data from QuerySelectQuery
 
        Set rst = CurrentDb.OpenRecordset("tblOrgSelect")
        rst.AddNew
        rst!Organization = MyRecordsetcriteria!org
        rst.Update
        rst.Close
        Set rst = Nothing

        Set Newrst = CurrentDb.OpenRecordset("Query100")    ' References Query100

        Xlsheet.Range("Location1").CopyFromRecordset Newrst ' Copies the data from Query 100 to to Location1
        
        
        Set CellRange1 = Xl.ActiveSheet.Range("E6")
        Set CellRange3 = Xl.ActiveSheet.Range("F5")

'           Code to test whether the data is one cell only, or more than one cell

        Set rst = CurrentDb.OpenRecordset("Query100A")        ' References Query100A
        Xlsheet.Range("e6").CopyFromRecordset rst             ' Copies the data from Query 100A to to Cell E6

        If IsEmpty(CellRange1.Offset(1, 0)) Then
        
            CellRange1.Copy
            
            CellRange3.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        
        Else
        
            Set CellRange2 = Xl.ActiveSheet.Range(CellRange1, CellRange1.End(xlDown))
            CellRange2.Copy

            CellRange3.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True

        End If

'           Erase temp listing

        If IsEmpty(CellRange1.Offset(1, 0)) Then
        
            CellRange1.Clear
        
        Else
        
            CellRange2.Clear
                
        End If
        
        Newrst.Close
        Set Newrst = Nothing

'           Save the Excel Workbook with an organization specific file name and dicconnect from the workbook
       
        XlBook.SaveAs "C:\Access Development\July 26, 2010 Folder\Test_" & MyRecordsetcriteria!org & ".xls"
        XlBook.Close

        MyRecordsetcriteria.MoveNext
        
    Loop

    MyRecordsetcriteria.Close
    Set MyRecordsetcriteria = Nothing

    ' Clean up and end with Excel worksheet NOT visible on the screen
    Set XlBook = Nothing
    Set Xlsheet = Nothing

    Xl.Quit
    Set Xl = Nothing
        
'           Now time to celebate success
        
End Sub


[\End Code]

Thanks everyone, for your help.