excel running and opening from msaccess throws up application-defined or object-defined error

the code below runs one loads the sheet then closes it down perfectly
the next time that it loops it it throws up an
application-defined or object-defined error
at Range("a1").Select in the below code

any help woudl be appreciated

Private Sub Command246_Click()
On Error GoTo Err_Command246_Click
   
        ' Set object variable equal to the OLE object.
        x = 1
        Do While x = 1
        Dim mySheet As Object, myfield As Variant, xlApp As Object
        Set xlApp = CreateObject("Excel.Application")
        ' Set mysheet = GetObject("c:\ole_test.xls", "excel.sheet").
       ' Set mySheet = xlApp.Workbooks.Open("C:\A HFT main Catalog\Email Scripts\googletwo.xls").Sheets(1)
        Set mySheet = xlApp.Workbooks.Open("C:\gotwo.xls").Sheets(1)
        mySheet.Visible = True
        xlApp.Visible = True
        Dim relatedind As String
        '    Range("a1:D1200").value
       '     Selection.ClearContents
       '     Selection.ClearContents
     '   Selection.Copy
        Range("a1").Select
        relatedind = ""
        Dim AnyRecsFound As String

         With ActiveSheet.QueryTables.Add(Connection:= _
          "URL;" & "http://www.whats-the-answer.com/app/puppies/en-gb?camp_id=4024" & "" _
          , Destination:=Range("B4"))
          .name = "http://www.whats-the-answer.com/app/puppies/en-gb?camp_id=4024"
          .FieldNames = True
          .RowNumbers = False
          .FillAdjacentFormulas = False
          .PreserveFormatting = True
          .RefreshOnFileOpen = False
          .BackgroundQuery = True
          .RefreshStyle = xlInsertDeleteCells
          .SavePassword = False
          .SaveData = True
          .AdjustColumnWidth = True
          .RefreshPeriod = 0
          .WebSelectionType = xlEntirePage
          .WebFormatting = xlWebFormattingNone
          .WebPreFormattedTextToColumns = True
          .WebConsecutiveDelimitersAsOne = True
          .WebSingleBlockTextImport = False
          .WebDisableDateRecognition = False
          .WebDisableRedirections = False
          .Refresh BackgroundQuery:=False
      End With
         
         
        xlApp.DisplayAlerts = False
            xlApp.Workbooks.Close
            xlApp.Quit
           
            Set xlApp = Nothing
    Loop
Exit_Command246_Click:
    Exit Sub

Err_Command246_Click:
    MsgBox Err.Description
    Resume 'Exit_Command246_Click
   
End Sub
sydneyguyAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

FaustulusCommented:
Just a guess:-
Range("A1").Select selects A1 in the ActiveSheet.
Which is the ActiveSheet? And is the ActiveSheet accessible?
Presuming that you intend MySheet to be the active sheet I suggest that you first explicitly select that sheet and then specify it for your selection:

MySheet.Select
MySheet.Range("A1").Select

Let me know if this cures the problem.
0
FaustulusCommented:
This is another potential source of trouble:-
        Do While x = 1
        Dim mySheet As Object, myfield As Variant, xlApp As Object
        Set xlApp = CreateObject("Excel.Application")

Open in new window

Observe that you are dimensioning within a loop. Depending upon how x develops the Dim statement could run many times. Access should point to "duplicate declarations" which isn't the error you get, but sometimes the application gets mixed up with its error identification, particularly, if there are several irregularities.

The rule to follow is to have all your Dim statements at the top of your procedure, before any code. "On Error GoTo Err_Command246_Click" is a part of the code.
0
FaustulusCommented:
I sorted through your code to make it readable. Here is the revised version.
Option Explicit

Private Sub Command246_Click()

    Dim xlApp As Object
    Dim mySheet As Object
    Dim myfield As Variant
    Dim relatedind As String
    Dim AnyRecsFound As String
    Dim x As Integer
        
    On Error GoTo Err_Command246_Click
   
    ' Set object variable equal to the OLE object.
    x = 1
    Do While x = 1
        Set xlApp = CreateObject("Excel.Application")
        ' Set mysheet = GetObject("c:\ole_test.xls", "excel.sheet").
        ' Set mySheet = xlApp.Workbooks.Open("C:\A HFT main Catalog\Email Scripts\googletwo.xls").Sheets(1)
        Set mySheet = xlApp.Workbooks.Open("C:\gotwo.xls").Sheets(1)
        mySheet.Visible = True
        xlApp.Visible = True
'        Range("a1:D1200").Value
'        Selection.ClearContents
'        Selection.ClearContents
'        Selection.Copy
        Range("a1").Select
        relatedind = ""

        With ActiveSheet.QueryTables.Add( _
                         Connection:="URL;" & "http://www.whats-the-answer.com/app/puppies/en-gb?camp_id=4024" & "", _
                         Destination:=Range("B4"))
            .Name = "http://www.whats-the-answer.com/app/puppies/en-gb?camp_id=4024"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
         
         
        With xlApp
            .DisplayAlerts = False
            .Workbooks.Close
            .Quit
        End With
            
        Set xlApp = Nothing
    Loop
    
Exit_Command246_Click:
    Exit Sub

Err_Command246_Click:
    MsgBox Err.Description
    Resume 'Exit_Command246_Click
    
End Sub

Open in new window

As becomes apparent now, x never develops into anything at all. It always stays 1. Therefore the entire loop is not required. You can remove it along with the declaration and assignment of x. Same for the variable 'relatedind'. Variable 'AnyRecsFound' is declared but never used.

The offending line Range("A1").Select isn't actually required, either. I guess, what you are trying to do is mySheet.Range("A1:D1200").ClearContents. You don't need to select the sheet or the range in order to manipulate it.

Observe that With ActiveSheet.QueryTables refers to the ActiveSheet which is defined by default. I don't know, off-hand, if Set mySheet = xlApp.Workbooks.Open("C:\gotwo.xls").Sheets(1) will activate the sheet. Anyway, use With mySheet.QueryTables if it is mySheet that you mean. ActiveSheet can be ambiguous.

Note that mySheet is visible by default. Perhaps what you were trying to do can be achieved with mySheet.Activate

I didn't test run the above code.
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

sydneyguyAuthor Commented:
thanks  for the code and the help but it still throws up a "application-defined or object-defined error
at line 27 ---  Range("a1").Select of the code
try running it please and see if it happens on your machine, maybe its a configuration problem. its on xp but i have a vist machine that the code jut crashes on when the import happens, another problem.
the loop is just something i put in for ease of code display , but i call the routing many times through the course of the calling routine.
0
sydneyguyAuthor Commented:
if i use the below code it runs fine the first time through but the second time it crashes out at  "With ActiveSheet.QueryTables.Add("  again with the user defined error.
ithought that i would be completly clearing all pointers to the file but obviously i am not

mySheet.Range("c1").Select
        relatedind = ""

        With ActiveSheet.QueryTables.Add( _
                         Connection:="URL;" & "http://www.whats-the-answer.com/app/puppies/en-gb?camp_id=4024" & "", _
                         Destination:=Range("B4"))
0
sydneyguyAuthor Commented:
tried changing to another sheet name at
Set mySheet = xlApp.Workbooks.Open("C:\gotwo.xls").Sheets(1)
to see if it was the sheet that was tieing up the ref or somthing strange to
Set mySheet = xlApp.Workbooks.Open("C:\copy of gotwo.xls").Sheets(1)
but it still crashed at the same point
0
FaustulusCommented:
Did you select the sheet?
You should have this code now,
        mySheet.Select
        mySheet.Range("a1").Select

Open in new window

The crash should come on the first line or not at all.
0
broro183Commented:
hi,

When running Excel related code from Access all object variables (such as Ranges or Actviesheets) need to be explicitly referenced (fully qualified) back to the level of Application (eg xlApp). This referencing can occur using With statements or parent-child relationships between variables. Using Range or Activesheet without a full qualification will result in a new (hidden) innsance of an excel application being created. These hidden instances can be seen in Task Manager.

I've made a couple of minor changes to Faustulus's version of the code including the points he noted. Hopefully it works now...

Option Explicit

Private Sub Command246_Click()

Dim xlApp As Object
Dim mySheet As Object
    'Dim myfield As Variant
Dim relatedind As String
    'Dim AnyRecsFound As String
    'Dim x As Integer

    On Error GoTo Err_Command246_Click

    '    ' Set object variable equal to the OLE object.
    '    x = 1
    '    Do While x = 1
    Set xlApp = CreateObject("Excel.Application")
    ' Set mysheet = GetObject("c:\ole_test.xls", "excel.sheet").
    ' Set mySheet = xlApp.Workbooks.Open("C:\A HFT main Catalog\Email Scripts\googletwo.xls").Sheets(1)
    xlApp.Visible = True
    Set mySheet = xlApp.Workbooks.Open("C:\gotwo.xls").Sheets(1)
    With mySheet
'        .Visible = True
        '        .Range("a1:D1200").ClearContents
        xlApp.Goto .Range("a1")
        relatedind = vbNullString

        With .QueryTables.Add( _
             Connection:="URL;" & "http://www.whats-the-answer.com/app/puppies/en-gb?camp_id=4024" & "", _
             Destination:=.Range("B4"))
            .Name = "http://www.whats-the-answer.com/app/puppies/en-gb?camp_id=4024"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    End With


    With xlApp
        .DisplayAlerts = False
        .Workbooks.Close
        .Quit
    End With

    Set xlApp = Nothing
    '    Loop

Exit_Command246_Click:
    Exit Sub

Err_Command246_Click:
    MsgBox Err.Description
    Resume    'Exit_Command246_Click

End Sub

Open in new window


hth
Rob
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
sydneyguyAuthor Commented:
thanks for you help up and running
0
broro183Commented:
I'm pleased I could help. Thank you for the points :-)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.