Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / May 2008

Tip: Looking for answers? Try searching our database.

Query macro to use default directory

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
CLR - 16 May 2008 23:52 GMT
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 - 17 May 2008 11:41 GMT
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
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.