В 4 задании Я привел пример последовательного выбора поиска в dbf файле и замену данные согласно этому поиску. Производился поиск последовательного доступа. Были применены InputBox и Popup. В этом скрипте происходит заданный поиск произвольного или прямого доступа. Конечно это как бы последовательный выбор, но поиск идет по всему dbf, и происходит переход на ту запись по счету, который укажите и замена там данных, которые будут указаны для этого. Тоже применяется фильтр в определении количества заменяемых данных. Можно отменить замену и снова начать поиск. Данные для замены могут быть разными и задачи поиска могут быть тоже разными. Скрипт этот - демонстрация поиска и замены в dbf файле с использованием приглашений и подачи в произвольном понятии. Для просмотра файла Я предоставил приложение WDBFVIEW.EXE. Это приложение запускается командой WshShell.Run
Предоставляю файл Adox5A.vbs
'*******************************************************************
' Имя: Adox5A.vbs
' Язык: VBScript
' Описание: Поиск и замена в DBF файле. Произвольный - прямой доступ к записи
' ADO,ADOX
'*******************************************************************
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 'Уже есть файл
'========== Проверка файла
If FSO.FileExists(NameFilSozDBF) Then
else
MsgBox "Нет файла "&NameFilSozDBF
WScript.Quit
end if
'========== Проверка файла
Set cat = Createobject("ADOX.Catalog")
'+++++++++++++++++++++++++++++++++++++++++
cat.ActiveConnection = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SDefaultDir & ";" & _
"Extended Properties=dBase IV;"
'+++++
' cat.ActiveConnection="Driver={Microsoft dBase Driver (*.dbf)};DBQ=" & SDefaultDir & ";Deleted=0;ReadOnly=0;Exclusive=1;"
'+++++
Set oCon = cat.ActiveConnection
oCon.CursorLocation = 3
strSQLdbf="SELECT * FROM " & NameFilSozDBF & " "
Set RS = oCon.Execute(strSQLdbf)
KlFieldsN = RS.Fields.count
KlRecsN=RS.RecordCount
if KlRecsN<=0 then
WScript.Echo("В файле " & NameFilSozDBF & " нет записей")
WScript.Quit
end if
'======================================== Поиск всех данных по выборке
Set RSN=WScript.CreateObject("ADODB.Recordset")
strSQLDbf="SELECT * FROM " & NameFilSozDBF & " "
RSN.open strSQLDbf,oCon,2,2
RSN.Requery
'On Error Resume Next 'Проверка ошибок
NomPozRSN=0 'Начальный номер позиции
RSN.MoveFirst
Do until Trim(st2)<>""
TITLE ="Поиск в поле ST2"
StDn = InputBox("Файл" & vbCrLf & NameFilSozDBF & vbCrLf & "Записей " & KlRecsN & vbCrLf & vbCrLf & "Введите данные для поиска" , TITLE)
if IsEmpty(StDn) then
MsgBox "Вы нажали Отмена!"
'WshShell.Run SDefaultDir & "\WDBFVIEW.exe " & SDefaultDir & "\" & FilDbfIst & " ",1,True
WScript.Quit
end if
'================ Фильтр =========
RSN.filter="[st2]='" & StDn &"'" 'Если поле имеет целое значение то опострофы можно убрать
Kzap=RSN.RecordCount ' кол. отобранных записей
RSN.filter=0 ' Отменяет фильтр
'================ Фильтр =========
if trim(Kzap)=0 then ' ---- 00
wscript.echo("Нет таких данных!")
else ' ---- 00
if trim(StDn)="" Then ' ---- 01
WScript.Echo("Вы не сделали ввод. Продолжение - любая клавиша.")
else ' ---- 01
'777777777777777777777777777777777777777777777777777777777
TITLE ="Замена в поле ST2 величины " & StDn
StNom = InputBox("Всего данных " & Kzap & vbCrLf& vbCrLf & "st2=" & StDn &_
vbCrLf & vbCrLf& "Введите номер по счету для замены" , TITLE)
kFn=0 'Количество найденых строк
for i=1 to KlRecsN
'if RSN.eof=True then 'Позиция находится после последней записи
' MsgBox "Eof"
' RSN.MoveFirst
' NomPozRSN=0 'Начальный номер позиции
'end if
if Kzap=1 then 'Если позиция вдруг станет находится после последней записи
RSN.MoveFirst
NomPozRSN=0 'Начальный номер позиции
end if
kFn=kFn+1
if IsEmpty(StNom) then
MsgBox"Вы нажали отмена поиска!"
exit for
end if
if Trim(StNom)>Trim(CStr(Kzap)) then
wscript.echo("Нет такого номера учета по счету!")
exit for
end if
RSN.Find "[st2] = '" & Trim(StDn) & "'",NomPozRSN, 1, 1
ZapVol=RSN.fields("st2").value
NomPozRSN=RSN.AbsolutePosition
'kkkkkkkkkkkkkkkkkkkkkkkkkkkk
if trim(StNom)="" Then ' ---1
WScript.Echo("Вы не сделали ввод. Продолжение - любая клавиша.")
exit for
else ' ---1
if kFn=CInt(Trim(StNom)) and ZapVol=StDn then ' ---2
TITLE="Замена в поле ST2 величины " & StDn
StZam = InputBox("Всего данных " & Kzap & vbCrLf& "Строка " & NomPozRSN & vbCrLf& "По счету " & kFn & vbCrLf& "st2=" & StDn & vbCrLf & vbCrLf& "Введите новые данные для замены" , TITLE)
if IsEmpty(StZam) then
MsgBox "Вы нажали отмена замены!"
exit for
end if
if trim(StZam)="" Then ' ---3
WScript.Echo("Вы не сделали ввод. Продолжение - любая клавиша.")
'RSN.MoveFirst
exit for
else ' ---3
St1Dem=RSN.Fields("st1").value
BtnCode = WshShell.Popup("Всего данных " & Kzap & vbCrLf & "Замена " & StDn & " на " & StZam & vbCrLf & "Позиция строки " & NomPozRSN & vbCrLf & "По счету " & kFn & vbCrLf &_
"st2=" & StDn & vbCrLf & St1Dem & vbCrLf & vbCrLf & "Заменить?",, "Ваш выбор:", 1 + 32)
if BtnCode=2 then 'Отмена
exit for
end if
if BtnCode=1 then 'Замена
RSN.Fields("st2").value=StZam
RSN.Update
RSN.Requery
WshShell.Run SDefaultDir & "\WDBFVIEW.exe " & SDefaultDir & "\" & FilDbfIst & " ",1,True
exit for
end if
end if ' ---3
end if ' ---2
end if '---1
'kkkkkkkkkkkkkkkkkkkkkkkkkkkk
RSN.AbsolutePosition=NomPozRSN
NomPozRSN=RSN.AbsolutePosition
RSN.MoveNext
next
RSN.MoveFirst
NomPozRSN=RSN.AbsolutePosition
RSN.AbsolutePosition=NomPozRSN
'777777777777777777777777777777777777777777777777777777777
end if ' ---- 01
end if ' ---- 00
Loop
'On Error goto 0
Set RSN = Nothing
RSN.close
Set RS = Nothing
RS.close
WScript.Quit
Остальное как обычно.
Перед запуском скриптов файл _222.dbf сохраните в другом каталоге для повторного применения, если случайно испортите или удалите. Файл WDBFVIEW.exe Я добавлю в эту подборку. Процесс поиска и замены данных в dbf файлов требует времени и зависит от объема файла и мощности компьютера.
Файлы сохранил в архив Занятие5.rar
Пробуйте.
Ссылка на файл https://disk.yandex.ru/d/qrNK51gujYFsyQ
Подписывайтесь на мой канал и ставьте лайки.