Версия для печати темы

Нажмите сюда для просмотра этой темы в оригинальном формате

WinCity.Ru _ Microsoft/Office Excel _ Сохранение в формате Dbf

Автор: mmmmvlad Суббота, 01 Марта 2008, 16:26

Я В Excel-2003 Открыл Едарп_район.dbf, 20 записей, В него были переписаны новые записи из открытой Workbooks("едарп.xls").worksheets(1).cells

Sub Едарп_район()
Max = Workbooks("едарп.xls").worksheets(1).range("b65536").end(xlup).row 'последняя Строка
For M = 2 To Max 'то Переносим Ячейки
If Workbooks("едарп.xls").worksheets(1).cells(m, 18).value <> "изм" Then
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 1) = "3351208"
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 2) = Workbooks("едарп.xls").worksheets(1).cells(m, 4)
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 3) = Workbooks("едарп.xls").worksheets(1).cells(m, 2)
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 4) = Workbooks("едарп.xls").worksheets(1).cells(m, 8)
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 5) = "2008"
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 6) = "02"
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 7) = "503"
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 8) = Workbooks("едарп.xls").worksheets(1).cells(m, 9)
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 9) = Workbooks("едарп.xls").worksheets(1).cells(m, 10)
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 10) = Workbooks("едарп.xls").worksheets(1).cells(m, 5)
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 11) = Workbooks("едарп.xls").worksheets(1).cells(m, 7)
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 12) = Workbooks("едарп.xls").worksheets(1).cells(m, 13)
Workbooks("едарп_район.dbf").worksheets(1).cells(n, 13) = Workbooks("едарп.xls").worksheets(1).cells(m, 16)
N = N + 1
End If
Next
End Sub

Вносится 700 записей. Сохраняю Как Едарп_район.xls, закрываю. Открываю Едарп_район.xls, все записи на месте.
Сохраняю Как Едарп_район.dbf, закрываю. Открываю Едарп_район.dbf, а в нем первые 20 записей из добавленых.
Должно быть 700.
Понимаю, что надо пару команд в макрос, но не знаю каких.
Можно программку перезаписи из *.xls в *.dbf

Заранее Благодарю. С Уважением бывший Нновичок (забыл пароль, пришлось перерегистрироваться)

Автор: Квазимодо Понедельник, 03 Марта 2008, 12:03

Детский вопрос, но: пустых строчек в сохраняемом листе нет?

Автор: mmmmvlad Понедельник, 03 Марта 2008, 13:14

Здравствуй Квазимодо! Пустых строк нет. Исходный Едарп_район.dbf использую, т.к. в нем есть структура записей файла. Информацию формирую в EXCEL, пользуясь приемами, почерпнутыми из Ваших программ.

В справке по EXCEL нашел, что можно сделать так:
Вставка -> Имя -> Присвоить
в открывшейся форме ввожу Имя: База_данных формула: =Едарп_район!R1C1:R700C13 OK

Сохраняю изменения и все получается.

Но очень хочется это делать в VBA...

Благодарю за помощь.

Автор: Квазимодо Вторник, 04 Марта 2008, 12:25

Тогда попробуем писать в DBF через ADO (ActiveX Data Objects). Вот процедурка для начала (тут в таблице всего 2 столбца и 5 строк, но ты сделаешь, как надо) :

Код

Sub Macro1()
Dim conn, path, cmd, fs
path = "c:\projects\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set conn = CreateObject("ADODB.Connection")
conn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path & ";Extended Properties=dBase IV")
If Not (fs.FileExists(path & "таблица_1.dbf")) Then
conn.Execute "CREATE TABLE таблица_1 (ID int, INFO char(30))"
End If
For i = 1 To 5 'это для примера
cmd = "INSERT INTO таблица_1 VALUES (" & Cells(i + 1, 1) & ",'" & Cells(i + 1, 2) & "')"
conn.Execute cmd
Next
conn.Close
Set conn = Nothing
Set fs = Nothing
End Sub

Здесь проверяется, существует ли файл DBF, и если нет, то он создается (для этого и нужен объект файловой системы fs), а если уже есть, то в него дописываются записи из текущего листа.
Хотя, если у тебя есть Visual FoxPro, возможно, лучше сделать наоборот - открывать книгу Excel и писать в базу оттуда. А то где DBF-файлы, там, скорее всего, есть и индексы, а с ними лучше из фокса.

Автор: mmmmvlad Вторник, 04 Марта 2008, 13:07

Огромное СПАСИБО!!!

Буду разбираться и делать "под себя"

До следующих проблем (вместо "Пока!")