Query macro to use default directory

[CLR]

Hi All.....

I have a little Query macro that works just fine on my computer, but
unfortunately has the path to the source file hard coded inside. I would
like the Query to always look to the default directory that the Excel
program is in to find the source file to query......no joy in any of my
efforts.......anybody know how?

Heres the code.........
Sub GetAccessFile()
Sheets("MainMenu").Select
Sheets.Add
ActiveSheet.Name = "NPRdatabase"

With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access
Database;DBQ=F:\LinvatecPrograms\_MichaelLosey\WorkingAPRIL08\April
NPRs.mdb;DefaultDir=F:\LinvatecPrograms\_Mich" _
), Array( _
"aelLosey\WorkingAPRIL08;DriverId=281;FIL=MS
Access;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("A1"))
.CommandText = Array( _
"SELECT `NPR Database`.`Disposition Date`, `NPR
Database`.`Inspection Date`, `NPR Database`.`NPR Origin`, `NPR
Database`.`NPR Number`, `NPR Database`.`Part Number`, `NPR Database`.`Serial
Number`, `NPR" _
, _
" Database`.`Vendor Code`, `NPR Database`.`Vendor Name`, `NPR
Database`.`No of Defects`, `NPR Database`.`Qty RTV`, `NPR Database`.`Defect
Description`, `NPR Database`.`Corrective Action`" & Chr(13) & "" & Chr(10) &
"FROM `F:\Linv" _
, _
"atecPrograms\_MichaelLosey\WorkingAPRIL08\April NPRs`.`NPR
Database` `NPR Database`" & Chr(13) & "" & Chr(10) & "ORDER BY `NPR
Database`.`Vendor Code`" _
)
.Name = "Query from MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
Range("a1").Select
End Sub

I could even use a Path/filename from a cell, if necessary..............

TIA
Vaya con Dios,
Chuck, CABGx3

[Bill Manville]

The macro recorder and MSQuery combine to make a pigs ear of the creation of
querytables. At one time there was a limit of 200 characters or so in the
Connection and Command parameters and they had to be turned into arrays of
strings; this is no longer the case (if I recall correctly).
The SQL is unnecessarily verbose and does not need to include the filename or
(in this case) the table name before each field name since there is only one
table involved.
I think the following should work

Sub GetAccessFile()
Dim MyPath As String

Sheets("MainMenu").Select
Sheets.Add
ActiveSheet.Name = "NPRdatabase"

MyPath = ThisWorkbook.Path
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=MS Access Database;DBQ=" & MyPath & _
"\April NPRs.mdb;DefaultDir=" & MyPath & _

";DriverId=281;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _

, Destination:=Range("A1"))

.CommandText = "SELECT `Disposition Date`, `Inspection Date`, " & _
"`NPR Origin`, `NPR Number`, `Part Number`, `Serial Number`, " & _
"`Vendor Code`, `Vendor Name`, `No of Defects`, `Qty RTV`, " & _
`Defect Description`, `Corrective Action` " & vbNewLine & _
"FROM `NPR Database`" & vbNewLine & _
"ORDER BY `Vendor Code`"

.Name = "Query from MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
Range("a1").Select
End Sub

Bill Manville
MVP - Microsoft Excel, Oxford, England