Создавать файл из XLS и XLSX научились, делать нормализацию тоже, а что дальше?
А дальше надо вводить имя файла в специальном диалоговом окне или еще окне приглашения. Для этого применим функцию InputBox, которое отображает диалоговое окно, в котором пользователь может ввести текст и нажать на кнопку. Файлы EXCEL остаются те же. Предоставляю файл AdoEDA5.vbs
По ходу приложу некоторые комментарии.
Содержание файла AdoED5.vbs
'*******************************************************************
' Имя: AdoED5.vbs
' Язык: VBScript
' Описание: Вывод данных из XLS файла в DBF
' Полностью ODBC для EXCEL и dBase и нормализация DBF из XLS или XLSX '
' и InputBox
'*******************************************************************
'On Error Resume Next 'Проверка ошибок
Set WshShell=WScript.CreateObject("WScript.Shell")
SDefaultDir=WshShell.CurrentDirectory
Set FSO = CreateObject("Scripting.FileSystemObject")
Вот здесь и вставим фрагмент с InputBox
Тем, кому нравится вводить в окне приглашения, посвящается.
Описать механизм работы этого фрагмента можно так. Создается цикл на проверку символьного выражения. И если есть символы, то набор символов в дальнейшем передается как имя файла и покидает тело цикла. Если имя неверно или нет такого файла, то снова появляется окно с приглашением ввести имя файла. Если отпала необходимость ввода имени файла надо нажать Esc или кнопку Отмена и все и все.
' ==== Выбор файла в каталоге в котором Вы находитесь ====
Do until Trim(sFoldFile)<>""
TITLE ="Выбор файла XLS или XLSX"
sFoldFile = InputBox("Каталог" & vbCrLf & SDefaultDir & vbCrLf & vbCrLf & "Введите имя файла",TITLE)
if IsEmpty(sFoldFile) then
MsgBox "Вы нажали Отмена!"
WScript.Quit
end if
if trim(sFoldFile)="" Then
WScript.Echo("Вы не выбрали файл. Выход любая клавиша.")
end if
Loop
NameFil=SDefaultDir & "\" & trim(sFoldFile)
' ==== Выбор файла в каталоге в котором Вы находитесь ====
Если же хотите выбрать файл из любого другого каталога, то наберите
NameFil=trim(sFoldFile)
' ==== Создаваемый 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 & ";"
set tables = cnnMain.OpenSchema(20)
do until tables.eof
ImList=tables("TABLE_NAME")
tables.movenext
loop
strSQLn="SELECT * FROM [" & ImList & "]"
Set RS = cnnMain.Execute(strSQLn)
KlFieldsN = RS.Fields.count 'Количество колонок в XLS, XLSX файле
KlRecsN=RS.RecordCount 'Количество строк в XLS, XLSX файле
'=================== Максимальное поле ==========
On Error Resume Next 'Проверка ошибок
ReDim MassDL(KlFieldsN-1)
for i=0 to KlFieldsN-1
st=RS.Fields(i).Name
strSQLnn="SELECT Max(Len(Trim(" & st & "))) FROM [" & ImList & "]"
set RSQQ = cnnMain.Execute(strSQLnn)
'v=RSQQ.Fields(0).Value
v=RSQQ.GetString
if v="" then
v=254
end if
if v=0 then
v=9
end if
' Запасной вариант
'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
'wscript.echo("i=" & i & " st=" & st & " v=" & MassDL(i))
v=""
next
On Error goto 0
v=0
RSQQ.Close
Set RSQQ = Nothing
'=================== Максимальное поле ==========
' ==============Ввод названий Полей базы данных
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.Open SConnect
RSN.open SQL,conn,3
' ======== Кодировка 866 ======= Этот фрагмент можно здесь убрать и поставить 1251
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 =======
On Error Resume Next 'Проверка ошибок
iuu=0 'Признак записи в текстовый файл
ikk=0 'Запись строки Строки ошибок
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 " & 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,KlRecsN и другие переменные А можно все это не указывать
Set WshShell=Nothing
Set FSO = Nothing
Set oFile=Nothing
set tables=Nothing
cnnMain.Close
Set cnnMain = Nothing
RSQ.close
Set RSQ = 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
'*******************************************************************
Если в файле XLS или XLS есть заголовки с пробелами , то нормализация из этих файлов не пройдет и потому надо пользоваться нормализацией из DBF. Этот фрагмент
' ==== Выбор файла в каталоге в котором Вы находитесь ====
Do until Trim(sFoldFile)<>""
TITLE ="Выбор файла XLS или XLSX"
sFoldFile = InputBox("Каталог" & vbCrLf & SDefaultDir & vbCrLf & vbCrLf & "Введите имя файла",TITLE)
if IsEmpty(sFoldFile) then
MsgBox "Вы нажали Отмена!"
WScript.Quit
end if
if trim(sFoldFile)="" Then
WScript.Echo("Вы не выбрали файл. Выход любая клавиша.")
end if
Loop
NameFil=SDefaultDir & "\" & trim(sFoldFile)
'NameFil=trim(sFoldFile)
' ==== Выбор файла в каталоге в котором Вы находитесь ====
надо вставить в файл AdoED3B.vbs но перед этим убрать
Set objArgs=WScript.Arguments
if objArgs.Count>0 then
fileVvod=objArgs(0)
else
WScript.Echo "Введите имя файла XLS или XLSX после AdoED3B.vbs"
WScript.Quit
end if
и
' ==== Ввод файла EXCEL через строку данные которого надо перевести в создаваемый во время процесса файл dbf ====
Set NameFil = FSO.GetFile(fileVvod)
Теперь можете просмотреть с помощью WDBFVIEW.EXE созданный dbf файл (_222.dbf) кому это просто захочется. В следующей статье я опишу другие действия с помощью VBScript .
Файл можно редактировать, а также переделать на JScript.
Ссылка на файл https://disk.yandex.ru/d/o-JD28DBcPzV1Q
