macro to import access data into excell

[GerryE]

I have created a macro in excel that will insert acess data. Can anyone help
me combine the GetDirectory Macro to my AD macro? I need to be able to
specify the file location and then have it extract the information from the
Xpress.mdb.


******AD Macro******

With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=" & s &
"\Xpress.mdb;DefaultDir=F:\Users\EVERYONE\2006 Quota" _
), Array( _
"tions\Add-Delete Test;DriverId=25;FIL=MS
Access;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("A1"))
.CommandText = Array( _
"SELECT Items.Quantity, Items.PN, Items.Description, Items.Tag1,
Items.Tag3, Items.FinalSell, Items.ExtendedSell" & Chr(13) & "" & Chr(10) &
"FROM `" & s & "\Xpress.mdb`.Items Items" & Chr(13) & "" & Chr(10) & "WHERE
(Ite" _
, "ms.Tag3 Is Not Null)" & Chr(13) & "" & Chr(10) & "ORDER BY
Items.Tag1")
.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
End Sub

********GetDirectory Macro*******

Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


Sub Test()
Dim Msg As String
Msg = "Please select a location for the backup."
MsgBox GetDirectory(Msg)
End Sub

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function