Recorded Macro\InputBox

[jonnj]

Good Morning

I have the following recorded Macro, which imports a specific db4 dbf into excel. However the data source C:\db4\PORT\426950\2004 will not remain constant. The last two subfolders will constantly change. I'm trying to have an inputbox change that Data Source without success. I tried to create a variable again without success.

Any help with this would be greatly appreciated.

Sub Testimport()
'
' Testimport Macro
' Macro recorded 4/28/2006 by laxlunn
'

'
Dim [data Source] As string
[data Source] = InputBox("Import Table:", "Importing 1099DBF", "")


With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\db4\PORT\426950\2004\;Mode=Share Deny Write;Extended P" _
, _
"roperties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engine Type=18;Jet" _
, _
" OLEDBatabase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database P" _
, _
"assword="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on Compact=False;" _
, "Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), _
Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("A_1099")
.Name = "A_1099"
.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:\db4\PORT\426950\2002\A_1099.DBF"
.Refresh BackgroundQuery:=False
End With

 

[SkipVought]

Hi,

I'm not sure about the CommandText. I think I used the Database name and you might need the Table Name. If so, enter table name via InputBox.

Also, you can filter the getopenfilename with one or more file extensions. Check HELP.

Sub Testimport()
    Dim sFName As String, sConn As String, sPath As String, sDB As String
    
    [b]sFName = Application.GetOpenFilename()[/b]
    
    sPath = Left(sFName, InStrRev(sFName, "\") - 1)
    
    sDB = Split(Split(sFName, "\")(UBound(Split(sFName, "\"))), ".")(0)
    
    sConn = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;"
    sConn = sConn & "Password="""";"
    sConn = sConn & "User ID=Admin;"
    sConn = sConn & "Data Source=" & sPath & ";"
    sConn = sConn & "Mode=Share Deny Write;Extended Properties="""";"
    sConn = sConn & "Jet OLEDB:System database="""";"
    sConn = sConn & "Jet OLEDB:Registry Path="""";"
    sConn = sConn & "Jet OLEDB:Database Password="""";"
    sConn = sConn & "Jet OLEDB:Engine Type=18;"
    sConn = sConn & "Jet OLEDB:Database Locking Mode=0;"
    sConn = sConn & "Jet OLEDB:Global Partial Bulk Ops=2;"
    sConn = sConn & "Jet OLEDB:Global Bulk Transactions=1;"
    sConn = sConn & "Jet OLEDB:New Database Password="""";"
    sConn = sConn & "Jet OLEDB:Create System Database=False;"
    sConn = sConn & "Jet OLEDB:Encrypt Database=False;"
    sConn = sConn & "Jet OLEDB:Don't Copy Locale on Compact=False;"
    sConn = sConn & "Jet OLEDB:Compact Without Replica Repair=False;"
    sConn = sConn & "Jet OLEDB:SFP=False"
    
   
    With ActiveSheet.QueryTables(1)
        .Connection = sConn
        .CommandType = xlCmdTable
        .CommandText = sDB
        .Refresh BackgroundQuery:=False
    End With
End Sub

Skip,
[sub]
[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount! [/sub]

 

[jonnj]

SkipVought,

First let me thank you for your reply.

Your code didn't work for me right off, but I must say that your use of spath and the insertion of it with the data source help me solve my problem. I am very grateful.

This is what I ended up with:

Dim spath As String
spath = "c:\db4\port\"
spath = InputBox("Import File", "Importing 1099.DBF", "c:\db4\port\")


With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & spath & ";Mode=;Share Deny Write; Extended P" _
, _
"roperties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engine Type=18;Jet" _
, _
" OLEDBatabase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database P" _
, _
"assword="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on Compact=False;" _
, "Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), _
Destination:=Range("A5"))
.CommandType = xlCmdTable
.CommandText = Array("A_1099")
.Name = "A_1099"
.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:\db4\PORT\426950\2002\A_1099.DBF"
.Refresh BackgroundQuery:=False
End With
End Sub

 

[SkipVought]

Once you add a querytable, you do not have to keep adding querytables.

Use the intitial querytable and simply modify the connect string and of Command string.

Skip,
[sub]
[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount! [/sub]