В 1 статье я указал, как вообще создать dbf файл. Поэтому повторять все, что уже описано я не буду. Файлы остаются те же. Теперь XLS или XLSX файл мы подзагружаем в качестве аргумента. Указываем файл после файла AdoED2.vbs
Выглядеть это будет так:
AdoED2.vbs _111.xls
или
AdoED2.vbs _111.xlsx
В консоле просто набираем AdoED2.vbs а затем _111.xls или _111.xlsx в зависимости от строки подключения
Содержание файла AdoED1.vbs изменится, но не на много и он будет перезаписан в файл AdoED2.vbs
Содержание файла AdoED2.vbs
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'****************************************************************************
' Имя: AdoED2.vbs
' Язык: VBScript
' Описание: Вывод данных из XLS файла в DBF
' Полностью ODBC для EXCEL и dBase, ADO через DefinedSize EXCEL и через строку ввода файла
'****************************************************************************
On Error Resume Next 'Проверка ошибок
Set objArgs=WScript.Arguments
if objArgs.Count>0 then
fileVvod=objArgs(0)
else
WScript.Echo "Введите имя файла XLS или XLSX после AdoED2.vbs"
WScript.Quit
end if
Set WshShell=WScript.CreateObject("WScript.Shell")
SDefaultDir=WshShell.CurrentDirectory
Set FSO = CreateObject("Scripting.FileSystemObject")
' ==== Ввод файла EXCEL через строку данные которго надо перевести в создаваемый во время процесса файл dbf ====
Set NameFil = FSO.GetFile(fileVvod)
' ==== Создаваемый 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
end if
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
RS.close
Set RS = Nothing
RSN.close
Set RSN = Nothing
conn.close
Set conn = Nothing
if iuu>0 then
WScript.Echo("Проверьте журнал ошибок _FileErr.txt. Файл " & NameFilDBF & " Создан!")
else
WScript.Echo("Файл создан!")
end if
WScript.Quit
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
В скрипт добавили вот такой фрагмент
Set objArgs=WScript.Arguments
if objArgs.Count>0 then
fileVvod=objArgs(0)
else
WScript.Echo "Введите имя файла XLS или XLSX после AdoED2.vbs"
WScript.Quit
end if
И вот такой
' ==== Ввод файла EXCEL через строку, данные которого надо перевести в создаваемый во время процесса файл dbf ====
Set NameFil = FSO.GetFile(fileVvod)
Остальное все то же что и в 1 статье.
Теперь можете просмотреть созданный dbf файл (_222.dbf) с помощью WDBFVIEW.EXE
Кому это просто необходимо. В следующей статье я опишу, как привести получаемый dbf файл к нормализации и другие действия с помощью VBScript .
Файл можно редактировать, а также переделать на JScript.
Ссылка на файл https://disk.yandex.ru/d/zGYr-0ViBtCWPg
