В статьях 1 и 2 я указал, как вообще создать dbf файл и вводить XLS или XLSX из строки. Поэтому повторять все, что уже есть, я не буду. Файлы остаются те же.
Теперь самое главное НОРМАЛИЗАЦИЯ dbf файла.
Что под этим лично я понимаю. Это то, что поля в dbf файле должны, соотносится по своим размерам от количества символов. Конечно, это можно сделать с помощью приложения WDBFVIEW.EXE, но лучше, если это можно сделать сразу.
Вы уже получаете удобный файл с известной так сказать структурой. Еще хорошо что зная это сразу сможете туда записывать данные не теряя время на дальнейшую нормализацию. Конечно, как говорится каждому свое, но я думаю лучше так. Ведь даже в EXCEL файле можно сделать AutoFit и не мучиться таким понятием. Но даже если в EXCEL файле это сделать, не всегда эти размеры переходят в DBF. Предполагать, знать и делать здесь могут выглядеть иначе и тут как получится. Я всегда радуюсь за тех, кто точно и утвердительно может это выразить. Значит у них очень большой опыт. Но не все могут подогнать заголовки и размеры EXCEL файла под DBF. Поэтому, кто работает с базами данных в других программах, по крайне мере это сделать могут в зависимости от своих знаний и возможности приложений. Предоставляю файл AdoED3A.vbs
Содержание файла AdoED3A.vbs
'*******************************************************************
' Имя: AdoED3A.vbs
' Язык: VBScript
' Описание: Вывод данных из XLS файла в DBF
' Полностью ODBC для EXCEL и dBase, ADO через DefinedSize EXCEL и нормализация DBF из DBF
'*******************************************************************
On Error Resume Next 'Проверка ошибок
Set WshShell=WScript.CreateObject("WScript.Shell")
SDefaultDir=WshShell.CurrentDirectory
Set FSO = CreateObject("Scripting.FileSystemObject")
' ==== Файл EXCEL данные которго надо перевести в создаваемый во время процесса файл dbf ====
NameFil=SDefaultDir & "\_111.xls"
' ==== Создаваемый DBF ====
NameFilDBF=SDefaultDir & "\_222.dbf"
' ==== Создаваемый Файл ошибок ====
FileTxt=SDefaultDir & "\_FileErr.txt"
'========== Проверка файла
If FSO.FileExists(NameFil) Then
else
MsgBox "Нет файла "&NameFil
WScript.Quit
end if
'========== Проверка файла
'=========== Проверка файла
If FSO.FileExists(FileTxt) Then
FSO.DeleteFile FileTxt
End if
'========== Проверка файла
'=========== Проверка файла
If FSO.FileExists(NameFilDBF) Then
FSO.DeleteFile NameFilDBF
End if
'========== Проверка файла
Set RSN=WScript.CreateObject("ADODB.Recordset")
Set conn = CreateObject("ADODB.Connection")
SConnect="Driver={Microsoft dBase Driver (*.dbf)};DBQ=" & SDefaultDir & ";"
Set cnnMain = CreateObject("ADODB.Connection")
cnnMain.CursorLocation = 3
cnnMain.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & NameFil & ";"
Dim ImList 'Если хотите можете оставить
set tables = cnnMain.OpenSchema(20)
do until tables.eof
ImList=tables("TABLE_NAME")
tables.movenext
loop
strSQL="SELECT * FROM [" & ImList & "]"
Set RS = cnnMain.Execute(strSQL)
objKlRecs=RS.RecordCount 'Количество строк в XLS, XLSX файле
objKlFields = RS.Fields.count 'Количество колонок в XLS, XLSX файле
' ==============Ввод названий Полей базы данных
SQL="create table " & NameFilDBF & "("
for i=0 to objKlFields-1
st=RS.Fields(i).Name
stDL= RS.Fields(i).DefinedSize
TypePl=RS.Fields(i).Type
if stDL>254 then
stDL=254
end if
if i=objKlFields-1 then
SQL=SQL & "st" & i & " char(" & stDL & "))"
else
SQL=SQL & "st" & i & " char(" & stDL & "),"
end if
next
' ============== Ввод названий Полей базы данных
conn.Open SConnect
RSN.open SQL,conn,3
' ======== Кодировка 866 ======= Этот фрагмент можно здесь убрать
Set oFile = FSO.GetFile(NameFilDBF)
With oFile.OpenAsTextStream()
readBinary = .Read(oFile.Size)
.Close
End With
readBinary=left(readBinary,29)+"e"+mid(readBinary,31)
With FSO.createTextFile(NameFilDBF)
.Write(readBinary)
.Close
End With
' ======== Кодировка 866 =======
iuu=0 'Признак записи в текстовый файл
ikk=0 'Запись строки Строки ошибок
for i=1 to objKlRecs
vvv="'"
for j=0 to objKlFields-1
st=RS.Fields(j)
if j=objKlFields-1 then
vvv=vvv & st & "'"
else
vvv=vvv & st & "'" & "," & "'"
end if
next
SQL="insert into " & NameFilDBF & " values(" & vvv & ")"
RSN.open SQL,conn,3
'11111111111111111111 Обработка ошибок 1111111111111111111
iu=0
If Err.Number <> 0 Then
iu=1
ikk=ikk+1
End If
if iu=1 then
iuu=i
Const ForWriting = 2
Set FOut = FSO.OpenTextFile(FileTxt,ForWriting,true)
if ikk=1 then
FOut.WriteLine "Строки ошибок"
end if
FOut.WriteLine (iuu)
end if
'11111111111111111111 Обработка ошибок 1111111111111111111
RS.MoveNext
next
if iuu>0 then
FOut.WriteLine "Ошибок " & iuu
FOut.Close
FOut.Nothing
if iuu=objKlRecs then 'Создается только шапка файла
WScript.Echo("Проверьте журнал ошибок _FileErr.txt. Ошибки во всех записях. Создана шапка файла " & NameFilDBF)
ikk=0
iuu=0
iu=0
' Можно указать i,j,objKlRecs и другие переменные А можно все это не указывать
Set WshShell=Nothing
Set FSO = Nothing
Set oFile=Nothing
set tables=Nothing
cnnMain.Close
Set cnnMain = Nothing
Set RS = Nothing
Set RSN = Nothing
conn.close
Set conn = Nothing
WScript.Quit
end if 'Создается только шапка файла
end if
On Error GoTo 0
'RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR Нормализация из DBF RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
'=================== Максимальное значение поля в DBF ==========
'On Error Resume Next 'Проверка ошибок ' Можно поставить если это необходимо
strSQLdbf="SELECT * FROM " & NameFilDBF & " "
Set RS = conn.Execute(strSQLdbf)
KlRecsN=RS.RecordCount 'Количество строк в DBF файле
KlFieldsN=RS.Fields.count 'Количество колонок в DBF файле
ReDim MassDL(KlFieldsN-1)
for i=0 to KlFieldsN-1
st=RS.Fields(i).Name
strSQLnn="SELECT Max(Len(" & st & ")) FROM " & NameFilDBF & " "
set RSQQ = conn.Execute(strSQLnn)
' Можно
' v=RSQQ.GetString
' Лучше
v=RSQQ.Fields (0).Value
if IsEmpty(v) then
v=9
end if
if IsNull(v) then
v=9
end if
if v="" then
v=254
end if
if v=0 then
v=9
end if
MassDL(i)=v
v=""
next
'On Error GoTo 0
v=0
RSQQ.Close
Set RSQQ = Nothing
'=================== Максимальное значение поля в DBF ==========
' ==============Ввод названий Полей базы данных
SQL="create table " & NameFilDBF & "("
for i=0 to KlFieldsN-1
st=RS.Fields(i).Name
stDL=MassDL(i)
if i=KlFieldsN-1 then
SQL=SQL & "st" & i & " char(" & stDL & "))"
else
SQL=SQL & "st" & i & " char(" & stDL & "),"
end if
next
' ==============Ввод названий Полей базы данных
'+++++++++++++++++++++ Снова открываем коннект
conn.close
SConnect="Driver={Microsoft dBase Driver (*.dbf)};DBQ=" & SDefaultDir & ";"
conn.Open SConnect
conn.CursorLocation = 3
'+++++++++++++++++++++ Снова открываем коннект
'=========== Заново удаляем файл dbf
If FSO.FileExists(NameFilDBF) Then
FSO.DeleteFile NameFilDBF
End if
'========== Проверка файла
'+++++++++++++++++++++ Снова открываем RecordSet
Set RSN=WScript.CreateObject("ADODB.Recordset")
RSN.open SQL,conn,3
' ======== Кодировка 866 =======
Set oFile = FSO.GetFile(NameFilDBF)
With oFile.OpenAsTextStream()
readBinary = .Read(oFile.Size)
.Close
End With
readBinary=left(readBinary,29)+"e"+mid(readBinary,31)
With FSO.createTextFile(NameFilDBF)
.Write(readBinary)
.Close
End With
' ======== Кодировка 866 =======
' ======== Заново перераспределяем RS лучше переспределить =======
On Error Resume Next 'Проверка ошибок
strSQL="SELECT * FROM [" & ImList & "]"
Set RS = cnnMain.Execute(strSQL)
objKlRecs=RS.RecordCount 'Количество строк в XLS, XLSX файле
objKlFields = RS.Fields.count 'Количество колонок в XLS, XLSX файле
iuu=0 'Признак записи в текстовый файл
ikk=0 'Запись строки Строки ошибок
for i=1 to objKlRecs
vvv="'"
for j=0 to objKlFields-1
st=RS.Fields(j)
if j=objKlFields-1 then
vvv=vvv & st & "'"
else
vvv=vvv & st & "'" & "," & "'"
end if
next
SQL="insert into " & NameFilDBF & " values(" & vvv & ")"
RSN.open SQL,conn,3
RS.MoveNext
next
if iuu>0 then
FOut.WriteLine "Файл перезаписан Ошибок " & iuu
FOut.Close
FOut.Nothing
end if
On Error GoTo 0
'RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR Нормализация RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
ikk=0
iuu=0
iu=0
' Можно указать i,j,objKlRecs и другие переменные А можно все это не указывать
Set WshShell=Nothing
Set FSO = Nothing
Set oFile=Nothing
set tables=Nothing
cnnMain.Close
Set cnnMain = Nothing
Set RS = Nothing
Set RSN = Nothing
conn.close
Set conn = Nothing
if iuu>0 then
WScript.Echo("Проверьте журнал ошибок _FileErr.txt. Файл создан " & NameFilDBF & " Создан!")
else
WScript.Echo("Файл создан!")
end if
WScript.Quit
'*******************************************************************
Естественно, файл увеличился в объеме
И вот здесь опишем что добавилось. А добавился внушительный фрагмент
'RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR Нормализация из DBF RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Вот и начнем. Нам надо узнать максимальное количество символом по каждому полю или так можно сказать его размер-длину.
'=================== Максимальное значение поля в DBF ==========
'On Error Resume Next 'Проверка ошибок ' Можно поставить, если это необходимо
Здесь считываем данные из DBF
strSQLdbf="SELECT * FROM " & NameFilDBF & " "
Определяем выполнение
Set RS = conn.Execute(strSQLdbf)
Ну здесь все ясно
KlRecsN=RS.RecordCount 'Количество строк в DBF файле
KlFieldsN=RS.Fields.count 'Количество колонок в DBF файле
Пересматриваем массив. Желательно ReDim и определяем массив MassDL
ReDim MassDL(KlFieldsN-1)
for i=0 to KlFieldsN-1
Выводим имена заголовков полей
st=RS.Fields(i).Name
Определяем максимальное количество символов в каждом поле
strSQLnn="SELECT Max(Len(" & st & ")) FROM " & NameFilDBF & " "
Выполняем этот действие
set RSQQ = conn.Execute(strSQLnn)
Находим величину максимального значения символом в каждом поле
' Можно
' v=RSQQ.GetString
' Лучше
v=RSQQ.Fields (0).Value
Проверяем эту величину и подстраиваем это значение. Здесь можно использовать IsEmpty и IsNull. В статье 1 это я уже указывал
if IsEmpty(v) then
v=9
end if
if IsNull(v) then
v=9
end if
if v="" then
v=254
end if
if v=0 then
v=9
end if
Записываем максимальные значения полей в массив
MassDL(i)=v
v=""
next
'On Error GoTo 0
Освобождаем память
v=0
RSQQ.Close
Set RSQQ = Nothing
'=================== Максимальное значение поля в DBF ==========
И вот здесь самый интересный момент. Создаем новую шапку с полями, которые соответствуют своим размерам по отношению к максимальной записи. Я пробовал применять ALTER, но не получилось. Если у кого получается изменение полей, то можете под статьей написать. Когда то у меня получалось изменять поля, но только когда данных в файле нет. Если удалять данные из базы, то это очень долго и все равно там остаются данные (удаленные). Поэтому легче удалить файл и заново его создать с новой структурой. В ADO нет упаковки dbf файлов. Я не нашел. Можно применить Строку провайдера FOXPRO, но это другой выбор работы.
' ==============Ввод названий Полей базы данных
SQL="create table" & NameFilDBF & "("
for i=0 to KlFieldsN-1
st=RS.Fields(i).Name
stDL=MassDL(i) ' Подставляется максимальное разрешение поля из массива
if i=KlFieldsN-1 then
SQL=SQL & "st" & i & " char(" & stDL & "))"
else
SQL=SQL & "st" & i & " char(" & stDL & "),"
end if
next
' ==============Ввод названий Полей базы данных
И все, проделаем то же, что и в начале, только не удаляем некоторые установки из памяти
'+++++++++++++++++++++ Снова открываем коннект
conn.close
SConnect="Driver={Microsoft dBase Driver (*.dbf)};DBQ=" & SDefaultDir & ";"
conn.Open SConnect
conn.CursorLocation = 3
'+++++++++++++++++++++ Снова открываем коннект
Обязательно удаляем уже созданный dbf файл.
'=========== Заново удаляем файл dbf
If FSO.FileExists(NameFilDBF) Then
FSO.DeleteFile NameFilDBF
End if
'========== Проверка файла
'+++++++++++++++++++++ Снова открываем RecordSet
Добавляем новую шапку (структуру полей) уже измененную.
Set RSN=WScript.CreateObject("ADODB.Recordset")
RSN.open SQL,conn,3
' ======== Кодировка 866 =======
Set oFile = FSO.GetFile(NameFilDBF)
With oFile.OpenAsTextStream()
readBinary = .Read(oFile.Size)
.Close
End With
readBinary=left(readBinary,29)+"e"+mid(readBinary,31)
With FSO.createTextFile(NameFilDBF)
.Write(readBinary)
.Close
End With
' ======== Кодировка 866 =======
И здесь все также как и в начале.
' ======== Заново перераспределяем RS лучше перераспределить =======
On Error Resume Next 'Проверка ошибок
strSQL="SELECT * FROM [" & ImList & "]"
Set RS = cnnMain.Execute(strSQL)
objKlRecs=RS.RecordCount 'Количество строк в XLS, XLSX файле
objKlFields = RS.Fields.count 'Количество колонок в XLS, XLSX файле
iuu=0 'Признак записи в текстовый файл
ikk=0 'Запись строки Строки ошибок
for i=1 to objKlRecs
vvv="'"
for j=0 to objKlFields-1
st=RS.Fields(j)
if j=objKlFields-1 then
vvv=vvv & st & "'"
else
vvv=vvv & st & "'" & "," & "'"
end if
next
SQL="insert into " & NameFilDBF & " values(" & vvv & ")"
RSN.open SQL,conn,3
RS.MoveNext
next
if iuu>0 then
FOut.WriteLine "Файл перезаписан Ошибок " & iuu
FOut.Close
FOut.Nothing
end if
On Error GoTo 0
'RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR Нормализация RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
В скрипт AdoED3A.vbs можно добавить вот такой фрагмент и создаем файл AdoED3B.vbs
Set objArgs=WScript.Arguments
if objArgs.Count>0 then
fileVvod=objArgs(0)
else
WScript.Echo "Введите имя файла XLS или XLSX после AdoED3.vbs"
WScript.Quit
end if
И вот такой.
' ==== Ввод файла EXCEL через строку, данные которого надо перевести в создаваемый во время процесса файл dbf ====
Set NameFil = FSO.GetFile(fileVvod)
Теперь можете просмотреть созданный dbf файл (_222.dbf) с помощью WDBFVIEW.EXE кому это просто захочется. В следующей статье я опишу, как привести получаемый dbf файл к нормализации сразу от EXCEL файла и другие действия с помощью VBScript .
Я запишу сразу 2 файла AdoED3A.vbs и AdoED3B.vbs
Файлы в архиве Файлы3.rar. Файлы можно редактировать, а также переделать на JScript.
Ссылка на файл https://disk.yandex.ru/d/xA3tyhn1yXyDZw