Importing Data from Access Query to Excel Sheet

[Memphis]

Hello everyone,
I have a Macros that Imports Data from an Access Table into a worksheet.
The name of the Access DB changes every month so I can not just run the same
Macros Every month. The Macros works great, I only need to add some code to
it to read the value (Where the user types the File Name) in cell F9 found in
and ad the file name to the path.

Here is the Macros(Read my comments please):

ImportDataFromAccess Macro
' Macro recorded 03/18/2009
'

'
' Here I Highlighted the Text in cell F9 of the Control Sheet
ActiveCell.FormulaR1C1 = "TestDBForExcel.mdb"
'Here I set the focus away from cell F9
Range("F11").Select
'Here I selected the Sheet were the import will take place
Sheets("PropData").Select
'Here the Import data begins, the DATA SOURCE path does not recognise
the F9 value, I believe it only copied the name from when I pasted the name.

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User
ID=Admin;Data Source=P:\MyDocuments\Access\TestDBForExcel.mdb;Mode=Share Deny
Write" _
, _
";Extended Properties="""";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engine " _
, _
"Type=5;Jet OLEDBatabase Locking Mode=0;Jet OLEDB:Global Partial
Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New " _
, _
"Database Password="""";Jet OLEDB:Create System Database=False;Jet
OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on Comp" _
, "act=False;Jet OLEDB:Compact Without Replica Repair=False;Jet
OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("8508Table Query")
'What is this? Is this where the file name could be changed?
.Name = "TestDBForExcel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
'Or is it here that I need to change the name of the .mdb file?
.SourceDataFile = "P:\MyDocuments\Access\TestDBForExcel.mdb"
.Refresh BackgroundQuery:=False
End With
Sheets("Control").Select
End Sub

 

[FSt1]

hi
try this...
dim dbname as string
dbname = range("F9").value
Source=P:\MyDocuments\Access\" & dbname & " .mdb;Mode=Share Deny
Write" _
'etc.

regards
FSt2

 

[Memphis]

Thank you for your help.
I am getting the following error:
Could Not find file P:\MyDocuments\Access\TestDBForExcel.mdb
And then the MS Jet OLEDB Initialization Info Screen is presented. On the
Data Source It has the full path highlighted in blue. I click OK and the same
Could Not find file message box appears. I click ok and I get the Debug box
and then It highlights in yellow the " .Refresh BackgroundQuery:=False" line

Here is the code i modified with your help:
Sub ImportDataFromAccess()
'

Dim dbname As String
dbname = Range("F9").Value
Sheets("PropData").Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User
ID=Admin;Data Source="P:\MyDocuments\Access\"" & dbname & " .mdb;Mode=Share
Deny Write" _
, _
";Extended Properties="""";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engine " _
, _
"Type=5;Jet OLEDBatabase Locking Mode=0;Jet OLEDB:Global Partial
Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New " _
, _
"Database Password="""";Jet OLEDB:Create System Database=False;Jet
OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on Comp" _
, "act=False;Jet OLEDB:Compact Without Replica Repair=False;Jet
OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("8508Table Query")
'What is this? Is this where the file name could be changed?
.Name = "WHAT GOES HERE? I deleted the old info and left it blank."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = ""P:\MyDocuments\Access\TestDBForExcel.mdb"
.Refresh BackgroundQuery:=False
End With
Sheets("Control").Select
End Sub

 

[FSt1]

hi.
i tested this before posting and it worked in 03 on xp so i am at a loss
now. i'll test again.
check F9 value and make sure there are no hidden spaces and that the
spellling is correct.

regards
FSt1

 

[Memphis]

Thank you so much! it worked like a charm

I may post some other questions later..

Thanks again