Слияние одного dbf в другой с одинаковым названием, но из разных директорий

[xamillion]

Возникла проблема слияния одного dbf в другой. Проблема усугубляется тем, что они имеют одинаковое название, причем dbf сохранить нужно в 866-й кодировке.

Т.е. имеем два файла adr.dbf - лежат они в разных директориях (dir1, dir2 - директории не меняются, путь постоянный), к тому который лежит в dir1 нужно подлить второй. Звучит просто, но не тут то было!!!

Помогите разрулить ситуёвину!

Виновники торжества прилагаются немного в упрощенно-искаженном виде...

[SAS888]

Может так устроит?

Sub Main()
    Dim ws As Worksheet, i As Long, p As String: Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Sheets(1): ws.Cells.ClearContents
    p = ThisWorkbook.Path & "\"
    Workbooks.Open Filename:=p & "dir1\adr.dbf"
    Cells.Copy ws.[A1]: ActiveWorkbook.Close False
    i = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Workbooks.Open Filename:=p & "dir2\adr.dbf"
    Range([A2], Cells(Rows.Count, 3).End(xlUp)).Copy ws.Cells(i, 1)
    ActiveWorkbook.Close False: Application.DisplayAlerts = False
    ThisWorkbook.SaveAs p & "MyDBF.dbf", xlDBF2, False
End Sub

Естественно, пути к файлам источникам и к папке, в которую тредуется сохранять объединенный файл, а также имя итогового файла, подставьте требуемые.
Пример во вложении. Откройте файл "Merging.xls" и запустите макрос "Main".

[xamillion]

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

Может так устроит?

Естественно, пути к файлам источникам и к папке, в которую тредуется сохранять объединенный файл, а также имя итогового файла, подставьте требуемые.
Пример во вложении. Откройте файл "Merging.xls" и запустите макрос "Main".

При обработке строчки ThisWorkbook.SaveAs p & "MyDBF.dbf", xlDBF2, False выдает ошибку "Run time error '1004' Команда не может быть выполнена над указанным диапазоном. Выберите одну ячейку из диапазона и повторите попытку."

Спасибо что откликнулись.

[SAS888]

Это все потому, что Вы игнорируете правила раздела и в вопросе не указываете свою версию Excel.
Приведенный выше код будет работать в Excel 2003. С Excel 2007 дело обстоит несколько иначе. Этот вопрос уже обсуждался здесь.

[doober]

Тогда такой вариант для любой версии .Папки с файлами не забудье изменить на свои

[xamillion]

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

Это все потому, что Вы игнорируете правила раздела и в вопросе не указываете свою версию Excel.
Приведенный выше код будет работать в Excel 2003. С Excel 2007 дело обстоит несколько иначе. Этот вопрос уже обсуждался здесь.

Извиняюсь... всегда забываю про версию... причем работаю строго в Excel 2003! На другой машине с Excel 2003 выдает тоже самое...

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

Тогда такой вариант для любой версии .Папки с файлами не забудье изменить на свои

Спасибо... пытаюсь разобраться... поменял на свои папки, но что-то не то...

[Teslenko_EA]

Здравствуйте xamillion.
для решения подобных задач предложение от doober использующее технологию применяемую в БД (базах данных) является правильным решением.
(да и Ваша задача была бы уместнее здесь)
но позволю себе несколько подкорректировать его предложение избавив конструкцию от перебора записей.

Sub addDBF_fromDBF()
Const sPath1 = "C:\join dbf\dir1"
Const sPath2 = "C:\join dbf\dir2"
'sPath1 и sPath2 папки размещения файлов adr.dbf исходного и целевого
Const sQ1 = "INSERT INTO adr IN '", sQ2 = "'[dBase IV;HDR=NO;IMEX=2] SELECT * FROM adr IN '", _
sQ3 = "'[dBase IV;HDR=NO;IMEX=2]"
Dim oCn As New ADODB.Connection
Const sCn = "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq="
 oCn.Open sCn + sPath1 + ";"
 oCn.Execute sQ1 + sPath2 + sQ2 + sPath1 + sQ3
oCn.Close
Set oCn = Nothing
End Sub

минусом является только то, что конструкция при повторном выполнении создаст набор дублей.
Евгений.

[doober]

Век живи век учись.Не знал.что так таблицы можно объеденить

[xamillion]

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

Здравствуйте xamillion.
для решения подобных задач предложение от doober использующее технологию применяемую в БД (базах данных) является правильным решением.
(да и Ваша задача была бы уместнее здесь)
но позволю себе несколько подкорректировать его предложение избавив конструкцию от перебора записей.
................................
минусом является только то, что конструкция при повторном выполнении создаст набор дублей.
Евгений.

Код исполняется без ошибок, но оба файла без изменений... что я не так делаю?
Спасибо за помощь!

[doober]

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

Код исполняется без ошибок, но оба файла без изменений... что я не так делаю?
Спасибо за помощь!

Не знаю,наверное на жучка не по центру жмете
А если серьезно-посмотрите правильность указания директории