импорт в эксель

[Demonmov]

Подскажите, есть код импорта заданного dbf-файла в эксель. Нужно переделать так, чтобы при запуске макроса была возможность выбора нужного dbf-файла.



With ActiveSheet.QueryTables.Add(Connect ion:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB .4.0;Password="""";User ID=Admin;Data Source=C:\Documents and Settings\admin_7\Ðàáî÷èé ñòîë\Ëèñò Micro" _
, _
"soft Excel_2\;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Dat" _
, _
"abase Password="""";Jet OLEDB:Engine Type=18;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Globa" _
, _
"l Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt 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("80010501")
.Name = "80010501"
.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\admin_7\80010501.DBF"
.Refresh BackgroundQuery:=False
End With
End Sub

[SAS888]

Можно, например, так:

Sub Main()
    Dim fName As String, fso
    With Application.FileDialog(msoFileDialogOpen)
        .Title = "Укажите файл": .Show
        If .SelectedItems.Count = 0 Then Exit Sub Else fName = .SelectedItems(1)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    With ActiveSheet.QueryTables.Add(Connection:=Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & fso.GetParentFolderName(fName) & _
        ";Mode=Share Deny Write;Extended Properties="""";Jet", _
        " OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=18;Jet OLEDB:Database ", _
        "Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet O", _
        "LEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compac", _
        "t Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination:=Range("A1"))
        .CommandType = xlCmdTable
        .CommandText = Array(fso.GetBaseName(fName))
        .Refresh BackgroundQuery:=False
    End With
End Sub

[Demonmov]

Работает,спасибо