Испарвление Записаного макроса импорта с DBF

[komar73]

Помогите пожалуйста. Я записал макрос который создает таблицу в excel из файла dbf. Что здесь нужно поменять чтобы при выполнении этого макроса запрашивало выбор файла с этой дериктории

With ActiveSheet.ListObjects.Add(SourceT ype:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB .12.0;Password="""";User ID=Admin;Data Source=D:\Abonent\сберкасса\;Mode=S hare Deny Write;Extended Pro" _
, _
"perties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=18;Jet O" _
, _
"LEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Pas" _
, _
"sword="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Je" _
, _
"t OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False" _
), Destination:=Range("$A$2")).QueryTa ble
.CommandType = xlCmdTable
.CommandText = Array("PL_1803")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "D:\Abonent\сберкасса\PL_1803.D BF"
.ListObject.DisplayName = "Таблица_PL_1803"
.Refresh BackgroundQuery:=False
End With
Columns("D:U").Select
Selection.Delete Shift:=xlToLeft
Range("Таблица_PL_1803[[#All],[NOM]]").Select
ActiveSheet.ListObjects("Таблица_PL _1803").TableStyle = ""

[Юнлинг]

Данный макрос ты записал с помощью макрорекодера. Видимо по этой причине ты не знаешь что делать дальше. Я бы поступил иначе.
Для решения в первую очередь необходимо создать Userform, поместить туда кнопку и ComboBox/
После чего проинициализировать Userform и набрать масив для комбобокса

dim i as integer
Private Sub UserForm_Initialize()
dim s as string
Set fs = Application.FileSearch
With fs
    .LookIn = "D:\Abonent\сберкасса"
    .Filename = "*.dbf"
    If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
            s= .FoundFiles(i)
           ComboBox.Additem (s)
        Next i
    Else
        MsgBox "There were no files found."
        unload userform
    End If
End With
end sub

Изменяем одну строку написанного макрорекодером макроса, а именно

Сообщение от komar73

;
.SourceDataFile = ...

на

      .SourceDataFile = "D:\Abonent\сберкасса\"+Combobox.List(Combobox.ListIndex)

[SAS888]

Во избежании возможных проблем, я бы не стал использовать метод Application.FileSearch (на сколько мне известно, в Excel 2007 он отключен).
Лучше Do...Loop.

[komar73]

Cоздал Userform, поместил туда кнопку и ComboBox. Как проинициализировать Userform и где набирать масив для комбобокса?

[Юнлинг]

Сообщение от komar73

Cоздал Userform, поместил туда кнопку и ComboBox. Как проинициализировать Userform и где набирать масив для комбобокса?

Если работешь в 2007 OFFICE обратись к SAS888. Он скажет как.
Если Office 2003 или XP, я тебе привел макрос инициализации и заполнения комбобокса.

[komar73]

Я наверное чтото не правильно сделал. Вот образец

[Юнлинг]

Сообщение от komar73

Я наверное чтото не правильно сделал. Вот образец

Исправлять твою прогу у меня просто нет времени, но ошибки я тебе укажу.
Первая. В инициализации у тебя лишний

END SUB

удали его.
Второе нет реакции на нажатую клавишу. Необходимо макрос из модуля ISEL перенести в процедуру

Private Sub CommandButton1_Click()
СЮДА
end sub

модуль можно удалить или сделать автозапуск

[komar73]

Ничего не получилось

[Юнлинг]

Сообщение от komar73

Ничего не получилось

Выпала минутка я подправил твой макрос.
Необходимо попробывать в пошаговом режиме, на ошибки.
Кстати у тебя была еще одна ошибка, а именно ты внутри процедуры change_combobox бездумно вставил процедуру из второго поста. Этого делать нельзя.