Найти тему
Некто

Занятие 1. Перенос данных из XLS или XLSX в DBF на VBScript с использованием ADOX

Что такое ADOX и для чего он нужен, Вы можете посмотреть в ИНТЕРНЕТе.

В предыдущих статьях я подробно рассказал, как можно создать текстовые файлы, файл dbf, EXCEL файлы. С помощью ADO можно работать, но теперь расскажу, как работать и создавать эти форматы с помощью ADOX.

Первый файл Adox1A.vbs полностью реализован с помощью ADOX. 2 файл Adox1B.vbs реализован совместно с ADOX и ADO. Здесь кому нравиться работать с драйверами могут просмотреть этот файл. ADO, ADOX, DAO все это решения работы WINDOWS приложений. Они могут дополнять друг друга и быть взаимозаменяемыми. По сути, они могут решать даже одну и ту же задачу в разном изложении и направлении. Все зависит от цели поставленной задачи и технического задания. 3 файл Adox1C.vbs реализован для любого EXCEL файла с вводом из строки консоли. Что лучше ADO или ADOX или их совместное использование это вопрос скорее оптимизации и интереса. Здесь можно только самому найти предпочтение и убеждение. В ADOX можно изменять имя поля, удалять столбец (колонку) и проводить другие действия.

Сейчас разберем файл Adox1A.vbs и по ходу повествования дам некоторые комментарии.

Приведем пример создания dbf файла из EXCEL файла.

'*******************************************************************

' Имя: Adox1A.vbs

' Язык: VBScript

' Описание: Вывод данных из EXCEL файла в DBF файл

' Полностью ADOX для EXCEL и dBase

'*******************************************************************

Set WshShell=WScript.CreateObject("WScript.Shell")

SDefaultDir=WshShell.CurrentDirectory

Set FSO = CreateObject("Scripting.FileSystemObject")

'Этот файл будет создаваться

FilDbfIst="_222.dbf"

PosS=InStr(1,FilDbfIst, UCase(".dbf"), 1)

ImFilFilDbf=Mid(FilDbfIst,1,PosS-1)

NameFilSozDBF=SDefaultDir & "\" & FilDbfIst 'Создается файл

NameFil=SDefaultDir & "\_111.xls"

'========== Проверка файла

If FSO.FileExists(NameFil) Then

else

MsgBox "Нет файла "&NameFil

WScript.Quit

end if

'========== Проверка файла

'=========== Проверка файла

If FSO.FileExists(NameFilSozDBF) Then

'MsgBox "Файл есть! Удаляем"

FSO.DeleteFile NameFilSozDBF

End if

'========== Проверка файла

'Вот здесь все достоинства ADOX

Set cat = Createobject("ADOX.Catalog")

Set cnn = CreateObject("ADODB.Connection")

Set tbl = Createobject("ADOX.Table")

'+++++++++++++++++++++++++++++++++++++++++

cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _

"Data Source=" & NameFil & ";Extended Properties=Excel 8.0"

ImList = cat.Tables(0).Name ' Имя 1 листа

'=================== Максимальное поле ==========

strSQLn="SELECT * FROM [" & ImList & "]"

Set oCon = cat.ActiveConnection

oCon.CursorLocation = 3

Set RS = oCon.Execute(strSQLn)

KlFieldsN = RS.Fields.count

KlRecsN=RS.RecordCount

if KlRecsN<=0 then

WScript.Echo("В файле " & NameFil & " нет записей")

WScript.Quit

end if

On Error Resume Next 'Проверка ошибок

ReDim MassDL(KlFieldsN-1),MassType(KlFieldsN-1)

for i=0 to KlFieldsN-1

st=RS.Fields(i).Name

MassType(i)=RS.Fields(i).Type

strSQLnn="SELECT Max(Len(" & st & ")) FROM [" & ImList & "]"

set RSQ = oCon.Execute(strSQLnn)

v=RSQ.GetString

if v="" then

v=254

end if

if v=0 then

v=9

end if

MassDL(i)=v

v=""

next

On Error GoTo 0

for i=0 to KlFieldsN-1

if KlRecsN=1 and KlFieldsN=1 then

st=RS.Fields(0).Name

if st="F1" then

WScript.Echo("В файле " & NameFil & " нет записей или не указаны Имена столбцов")

WScript.Quit

end if

end if

next

'=================== Создание DBF и оптимизация полей ==========

cat.ActiveConnection = _

"Provider=Microsoft.Jet.OLEDB.4.0;" & _

"Data Source=" & SDefaultDir & ";" & _

"Extended Properties=dBase IV;"

Set oCon = cat.ActiveConnection

oCon.CursorLocation = 3

'Вот здесь происходит создание dbf файла, его атрибутов. Вся прелесть работы ADOX

tbl.NAME = ImFilFilDbf 'Имя DBF файла

for i=0 to KlFieldsN-1

Set col = Createobject("ADOX.Column")

col.Name="st"&i

stDL=MassDL(i)

stType=MassType(i)

col.DefinedSize=stDL

'col.Type=stType 'Можете указывать, а можете нет

tbl.Columns.Append col

next

cat.Tables.Append (tbl) 'Создание DBF

Erase MassDL

Erase MassType

'=================== Оптимизация полей в DBF ==========

' ======== Кодировка 866 =======

Set oFile = FSO.GetFile(NameFilSozDBF)

With oFile.OpenAsTextStream()

readBinary = .Read(oFile.Size)

.Close

End With

readBinary=left(readBinary,29)+"e"+mid(readBinary,31)

With FSO.createTextFile(NameFilSozDBF)

.Write(readBinary)

.Close

End With

' ======== Кодировка 866 =======

for i=1 to KlRecsN

vvv="'"

for j=0 to KlFieldsN-1

st=RS.Fields(j)

if j=KlFieldsN-1 then

vvv=vvv & st & "'"

else

vvv=vvv & st & "'" & "," & "'"

end if

next

SQL="insert into " & NameFilSozDBF & " values(" & vvv & ")"

Set oRs = oCon.Execute(SQL)

' Можно и так если не надо продолжения oCon.Execute(SQL)

RS.MoveNext

next

'+++++++++++++++++++++++++++++++++++++

Set col = Nothing

Set tbl = Nothing

Set cat = Nothing

Set oRs = Nothing

RS.close

Set RS = Nothing

RSQ.close

Set RSQ= Nothing

WScript.Echo("Файл " & NameFilSozDBF & " создан!")

WScript.Quit

Остальное как обычно.

Можно перевести в текстовый файл.

Перед запуском скриптов файл _111.xls сохраните в другом каталоге для повторного применения, если случайно испортите или удалите.

Процесс переноса данных в dbf из больших EXCEL файлов требует времени и зависит от объема файла и мощности компьютера.

Так как начал новое направление все файлы сохранил в архив Занятие1.rar

Пробуйте.

Ссылка на файл https://disk.yandex.ru/d/GO0klSrjJsu91g

Подписывайтесь на мой канал и ставьте лайки.