Object defined error

[Rhonda]

Hi,

I was given this code from another post but after I tried
to run it, it gives me a couple of errors.
Here is what I wanted it to do
Is it possible to create a routine for a command button
that would prompt the user to enter a query name(achieved
when you right click on a query and then open Data Range
Properties, this is the actual name of the iqy file)and
when the user enters the name, he can then delete it from
it's place on the spreadsheet(in my case it would be
somewhere in sheet 2) and the iqy file stored in the
Microsoft/Queries default folder? Maybe you know another
way of handling it. Either way, I would be truly
grateful!!!!

Here is what someone responded with:

Excel creates a range name when a query is added to the
sheet that is the same as the iqy file name. This loops
through the querytables to find one with the same range
as that range name, then deletes it. The problem that
you may run into is if more than one query is created
with the same iqy file. If you were to delete a query,
then create another query with the same name, it would
append an "_1" to the end of the range name which would
cause a problem. Hopefully it will get you started
though.



Here is the code:
Dim Fname As String
Dim RngName As String
Dim qt As QueryTable

ChDir "C:\Program Files\Microsoft Office\Office\Queries\"
Fname = Application.GetOpenFilename

If Fname <> "False" Then
RngName = Left(Dir(Fname), Len(Dir(Fname)) - 4)
For Each qt In Sheets("QuerySheet").QueryTables
If (qt.ResultRange.Address) = (ActiveSheet.Range
(RngName).Address) Then
qt.SaveData = False
ActiveSheet.Range(RngName).ClearContents
ActiveSheet.Names(RngName).Delete
Exit For
End If
Next qt
Kill Fname
End If
When it gets to the second if, I run into trouble. the
range its picking up for the query is wrong and the third
if gives me an object defined error.


Could soneone please clean up this code for me so it can
work, its an excellent idea that I need to make my
project complete. Thank you

 

[Tom Ogilvy]

Dim Fname As String
Dim RngName As String
Dim qt As QueryTable
Dim sh As Worksheet
Dim sPath As String
Dim sName As String
Dim bFlag As Boolean
Dim rng As Range
sPath = Application.Path & "\Queries"

Set sh = Worksheets(2)

ChDrive sPath
ChDir sPath
Fname = Application.GetOpenFilename( _
filefilter:="Query Files (*.iqy),*.iqy")

If Fname <> "False" Then
sName = Dir(Fname)
RngName = Left(sName, Len(sName) - 4)
On Error Resume Next
Set rng = sh.Range(RngName)
On Error GoTo 0
If Not rng Is Nothing Then
For Each qt In sh.QueryTables
If qt.ResultRange.Address = rng.Address Then
bFlag = True
qt.SaveData = False
sh.Range(RngName).ClearContents
ThisWorkbook.Names(RngName).Delete
Exit For
End If
Next qt
If bFlag Then
Kill Fname
Else
MsgBox sName & " query was not found"
End If
Else
MsgBox "Range with name " & RngName & " not found"
End If
End If

Regards,
Tom Ogilvy