Применение InputBox не очень наглядный выбор файла. Есть еще более наглядный пример работы с файлами и каталогами. Это BrowseForFolder метод создания диалогового окна для выбора папок и файлов. Про этот метод в ИНТЕРНЕТе написано очень много и примеров дано то же много. Поэтому я не буду описывать все его свойства.
Приведу лишь пример с циклом. Вы сами можете создать такое решение и возможно сделаете лучше. Также это можно сделать без цикла. Вам выбирать удобство работы.
Set oShell=WScript.CreateObject("Shell.Application")
On Error Resume Next 'Проверка ошибок
Do until Trim(NameFil)="-1"
'Если корневая папка и видимость всех объектов
' Set oItem= oShell.BrowseForFolder(0, "Выберите файл:", &H0001+&H4000+512,"")
'Если папка установленная Вами
Set oItem= oShell.BrowseForFolder(0, "Выберите файл:", &H0001+&H4000+512,SDefaultDir)
NameFil =oItem.self.Path 'Полный путь к файлу
sStr=len(trim(NameFil))
if sStr>3 then
if uCase(Mid(trim(NameFil),sStr-2,3))="XLS" then
if Mid(trim(NameFil),sStr-3,1)="." then 'xls
exit do
end if
end if
if uCase(Mid(trim(NameFil),sStr-3,4))="XLSX" then
if Mid(trim(NameFil),sStr-4,1)="." then 'xlsx
exit do
end if
end if
end if
if Err.Number<>0 then
if Err.Number=424 then
WScript.Echo("Файл не выбран. Отмена")
WScript.Quit
end if
end if
loop
On Error Goto 0
Err.Clear
Я сделал так, что проверяются файлы XLS и XLSX на выбор (в зависимости от строки подключения). Файлы EXCEL остаются те же. Основная задача была создание файла dbf из EXCEL, а диалоговые окна Вы можете создать сами. Есть еще метод POPUP. Про него также написано очень много в ИНТЕРНЕТе. В общем, Вам решать, как выбрать EXCEL файл для создания dbf файла и последующей с ним работы. Вместо -1 можете поставить любой символ для постоянного цикла. Все это выглядит вот так
Могу еще дополнить, что делал другие скрипты на VBScript полностью на HTA и HTML, Конечно на VBScript не стоит делать очень большие решения задач программирования, но возможно построить небольшие базы данных. Стоит ли этого, решать Вам.
В качестве примера привожу СКРИН примера на HTA обзор папок и вывод данных по файлам в текстовый файл, который делал задолго до этих статей. Форму HTML(HTM) Вы можете создать прямо из самого vbs. Все на Ваше усмотрение и желание а также радость от содеянного.
Содержание файла AdoED6.vbs
'*******************************************************************
' Имя: AdoED6.vbs
' Язык: VBScript
' Описание: Вывод данных из XLS файла в DBF
' Полностью ODBС для EXCEL и dBase и нормализация DBF из XLS или XLSX
' BrowseForFolder
'*******************************************************************
'On Error Resume Next 'Проверка ошибок
Set WshShell=WScript.CreateObject("WScript.Shell")
SDefaultDir=WshShell.CurrentDirectory
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oShell=WScript.CreateObject("Shell.Application")
' ==== Выбор файла в каталоге в котором Вы находитесь ====
On Error Resume Next 'Проверка ошибок
Do until Trim(NameFil)="-1"
' Set oItem= oShell.BrowseForFolder(0, "Выберите файл:", &H0001+&H4000+512,"")
Set oItem= oShell.BrowseForFolder(0, "Выберите файл:", &H0001+&H4000+512,SDefaultDir)
NameFil=oItem.self.Path 'Полный путь к файлу
sStr=len(trim(NameFil))
if sStr>3 then
if uCase(Mid(trim(NameFil),sStr-2,3))="XLS" then
if Mid(trim(NameFil),sStr-3,1)="." then 'xls
exit do
end if
end if
if uCase(Mid(trim(NameFil),sStr-3,4))="XLSX" then
if Mid(trim(NameFil),sStr-4,1)="." then 'xls
exit do
end if
end if
end if
if Err.Number<>0 then
if Err.Number=424 then
WScript.Echo("Файл не выбран. Отмена")
WScript.Quit
end if
end if
loop
On Error Goto 0
Err.Clear
' ==== Создаваемый DBF ====
NameFilDBF=SDefaultDir & "\_222.dbf"
' ==== Создаваемый Файл ошибок ====
FileTxt=SDefaultDir & "\_FileErr.txt"
'=========== Проверка файла
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
MassDL(i)=v
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 oShell=Nothing
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
'*******************************************************************
В следующей статье я опишу, как получить dbf файл из текстового файла и другие действия с помощью VBScript .
Решение можно редактировать, а также переделать на JScript.
Файл прилагать не буду. Можете взять его из вышеприведенного текста.
