Search for and select and database to import to excel

Hi all,

I have a code which imports data from a certain database, see below:

Sub Import_PPG()
'
' Import_PPG Macro
' Macro recorded 24/01/2008 by Chris Mann
'

'
    Columns("A:U").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:=Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\Documents and Settings\cmann29\My Documents\2007" _
        , _
        " Test Converter Tool\New WTB14768.mdb;Mode=ReadWrite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path" _
        , _
        "="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;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:Encryp" _
        , _
        "t Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        , ""), Destination:=Range("A1"))
        .CommandType = xlCmdTable
        .CommandText = Array("PPG")
        .Name = "New WTB14535"
        .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 = _
        "C:\Documents and Settings\cmann29\Desktop\Chris Mann\2007 Test Converter Tool\New WTB14535.mdb"
        .Refresh BackgroundQuery:=False
    End With
End Sub

However, I want the user to be able to specify the database using an input box, or a combo-box or something similar. I know its possible but I'm a little stuck. Basically, I would like the user to only have to put in the name of the database (as they will all be in the same folder).

Any Ideas?

*Apologies for the grammatical error in the title*

You can use the GetOpenfilename method, which will display a dialog that allows you to select a file and or change folders.

    Dim strPath As String
    Dim vntFile As Variant
    
    strPath = "C:\Documents and Settings\cmann29\My Documents\2007 Test Converter Tool\"

' set initial folder to display in dialog
    ChDrive strPath
    ChDir strPath
    
    vntFile = Application.GetOpenFilename("Database File *.mdb,*.mdb,All Files *.*,*.*")
    If vntFile = False Then Exit Sub
    
    MsgBox "Open " & vntFile

It would go at the top of your code.
GetOpenfilename does not open any files it just displays the dialog and returns file(s) selected by the user.
The returned value would be incorporated in to your query.

Sub Import_PPG()
'
' Import_PPG Macro
' Macro recorded 24/01/2008 by Chris Mann
'
    Dim strPath As String
    Dim vntFile As Variant
    
    strPath = "C:\Documents and Settings\cmann29\My Documents\2007 Test Converter Tool\"

    ChDrive strPath
    ChDir strPath
    
    vntFile = Application.GetOpenFilename("Database File *.mdb,*.mdb,All Files *.*,*.*")
    If vntFile = False Then Exit Sub
    
'
    Columns("A:U").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:=Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & vntfile , _
        ";Mode=ReadWrite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path"

The error could be because the value in strPath is a folder that does not exist. Make sure the folder name is correct.

So is this the folder where the data should be?

"C:\Documents and Settings\cmann29\My Documents\2007 Test Converter Tool\"

If not replace it with the correct folder name.