Query macro to use default directory   

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

date: Fri, 16 May 2008 18:52:54 -0400   author:   CLR

Re: Query macro to use default directory   

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

date: Sat, 17 May 2008 11:30:50 GMT   author:   Bill Manville