Создать DBF, сохранить в него данные из XLS

RomaS · 11 фев 2009, 14:10

Добрый день!
Вновь нужна Ваша помощь.
Имеется книга эксель. Нужно на дискете создать DBF и из одного листа книги сохранить определенные данные в этот DBF. (Также присвоить имена столбцам!)
Пробовал сохранить так:

Код: Выделить всё

 With ActiveWorkbook
.SaveAs Filename:=ThisWorkbook.Path & "\Kl.dbf", _
FileFormat:=xlDBF4, CreateBackup:=False
.Close
End With

Сохранение происходит, но: Названия столбцов ставятся N1, N2, ... Можно конечно открыть созданный файл и заменить первую строчку, но я уверен есть способ присвоить имя еще на стадии создания/ копирования/ сохранения

Teslenko_EA · 11 фев 2009, 23:24

Здравствуйте RomaS.
Поместив в модуль предлагаемый код и подключив к проекту библиотеку ADO, задача решается с помощью запроса создающего DBF файл:

Код: Выделить всё

Sub excelToDbf() 'sFile$, sPath$)
Dim ssql$, i%, s$, sFile$, sPath$
sPath = "C:\":  sFile = "T2" 'имя и путь сохраниния dbf файла
For i = 1 To 10 'в первой строке имена полей "удовлетворяющие" dbf (без пробелов, знаков пунктуации....)
    s = Cells(1, i):    ssql = ssql + " Tbl.[" + s + "],"
Next
ssql = Left(ssql, Len(ssql) - 1)
ssql = "select" + ssql + " into " + sFile + " IN '" + sPath + _
                "'[dBase IV;HDR=NO;IMEX=2] From [Лист1$A1:J50] as Tbl"
'Лист1$A1:J50 lдиапазон передаваемый в dbf, колонка J = 10 задано в цикле i
'кол-во строк (50) задавать реальное, для передачи всех строк в dbf
'и без пустых записей
If toDBF(ssql) Then Debug.Print "Good"
End Sub
Function toDBF(ssql$) As Boolean
Dim cn As New ADODB.Connection, str_cn$, sSQL1 As String
Set cn = New ADODB.Connection
str_cn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + ThisWorkbook.Path + "\" + ThisWorkbook.Name + ";" _
& "Extended Properties=""Excel 8.0;HDR=Yes"";"
On Error Resume Next
cn.ConnectionString = str_cn:       cn.Open
If Not cn.State = 1 Then Exit Function
cn.Execute ssql
cn.Close:       Set cn = Nothing
If Err.Number = 0 Then toDBF = True
End Function

Евгений

RomaS · 12 фев 2009, 06:47

Спасибо, а без доп библиотек видимо никак?
у меня подключена ADOConnectObject Class. ругается. А какая нужна?

Teslenko_EA · 12 фев 2009, 08:42

RomaS, "доп библиотеки" поставляются с MS Office.
Tools/References... Micrisoft ActiveX Data Objects X.X Library
Евгений.