Dim A(1 To 20)
A(1)="..."
A(2)="..."
...
For i=1 To 20
File1.Path=A(i)
For k=1 To File1.ListCount
Open A(i) & "\" & File1.List(k-1) For Input As #1
For j=1 To X ' X - количество строк в файле.
Input #1, B(j)
If Instr(B(j), "Любой")>0 Then ... ' придумаешь сам :D ... да и не забудь добавить процедуру записи обратно в файл
Next j
Close #1
Next k
Next i
Можно ли заменить фрагмент текста в файлах, находящихся в папках и подпапках?
Вот есть такая необходимость, как заменить текст "Любой" на "Any".
Файлы, где это надо сделать, сидят в папке:
C:\Program Files\Adobe\PageMaker 7.0\RSRC\USENGLSH\Plugins\Scripts\
и там есть две подпапки Bw и Clr, в которых, в свою очередь, есть примерно по 10 подпапок, в которых и находятся файлы, содержащие фрагменты текста, подлежащие изменению.
Можно ли это как-то прописать, чтобы не повеситься (там файлов примерно 500 в одной и 1000 в другой). Фрагмент есть не во всех файлах, но в более, чем половине. Очень бы не хотелось бы принять мучительную смерть из-за незнания, видимо, простых вещей :o .
Файлы, где это надо сделать, сидят в папке:
C:\Program Files\Adobe\PageMaker 7.0\RSRC\USENGLSH\Plugins\Scripts\
и там есть две подпапки Bw и Clr, в которых, в свою очередь, есть примерно по 10 подпапок, в которых и находятся файлы, содержащие фрагменты текста, подлежащие изменению.
Можно ли это как-то прописать, чтобы не повеситься (там файлов примерно 500 в одной и 1000 в другой). Фрагмент есть не во всех файлах, но в более, чем половине. Очень бы не хотелось бы принять мучительную смерть из-за незнания, видимо, простых вещей :o .
на твоём месте я бы сделал так: обявил массив адресов (то есть адреса всех подпапок), добавил FileListBox, а дальше воспользовался бы просто циклом For ... Next
Много циклов, конечно, но... кто предложит лучше? :p
Код:
Много циклов, конечно, но... кто предложит лучше? :p
Я тут пометил свои вопросики в самом коде с номерками, чтобы проще было бы ответить, если будет желание :o
Спасибо.
Код:
Dim A(1 To 20)
A(1)="..." --1) это пути к подпапкам, я правильно понимаю?
A(2)="..."
...
For i=1 To 20 -- 2) (кол-во подпапок?)
File1.Path=A(i)
For k=1 To File1.ListCount
Open A(i) & "\" & File1.List(k-1) For Input As #1
For j=1 To X ' X - количество строк в файле.
3) может быть тут лучше написать условие "пока не наступит EOF"?
Input #1, B(j) --а [COLOR="Navy"]B[/COLOR] что такое?
If Instr(B(j), "Любой")>0 Then ... ' придумаешь сам :D ... да и не забудь добавить процедуру записи обратно в файл
4) т.е. надо подставить сюда инструкцию Close #1, а потом Open #1 for Output?
Или можно не закрывая тут же потребовать Open for Output?
Next j
Close #1
Next k
Next i
A(1)="..." --1) это пути к подпапкам, я правильно понимаю?
A(2)="..."
...
For i=1 To 20 -- 2) (кол-во подпапок?)
File1.Path=A(i)
For k=1 To File1.ListCount
Open A(i) & "\" & File1.List(k-1) For Input As #1
For j=1 To X ' X - количество строк в файле.
3) может быть тут лучше написать условие "пока не наступит EOF"?
Input #1, B(j) --а [COLOR="Navy"]B[/COLOR] что такое?
If Instr(B(j), "Любой")>0 Then ... ' придумаешь сам :D ... да и не забудь добавить процедуру записи обратно в файл
4) т.е. надо подставить сюда инструкцию Close #1, а потом Open #1 for Output?
Или можно не закрывая тут же потребовать Open for Output?
Next j
Close #1
Next k
Next i
Спасибо.
Цитата: Dmitry2064
... Можно ли это как-то прописать, чтобы не повеситься (там файлов примерно 500 в одной и 1000 в другой)...
Используйте рекурсию.
По моему мнению, подобную задачу проще всего решить с использованием модели FSO.
Код:
Sub Example()
Call View_Folder("C:\Temp")
End Sub
Function View_Folder(strFolder As String)
Dim objFS As Object, objFolder As Object, objItem As Object
Call Replace_Word(strFolder)
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolder)
For Each objItem In objFolder.SubFolders
Call View_Folder(objItem.Path)
Next objItem
Set objFolder = Nothing
Set objFS = Nothing
End Function
Function Replace_Word(strFolder As String)
Dim objFS As Object, objFolder As Object, objItem As Object
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolder)
For Each objItem In objFolder.Files
If StrComp(objFS.GetExtensionName(objItem.Name), "txt", vbTextCompare) = 0 Then 'расширение фалов укажите своё
'здесь должен быть код для выполнения замены слова
End If
Next objItem
Set objFolder = Nothing
Set objFS = Nothing
End Function
Call View_Folder("C:\Temp")
End Sub
Function View_Folder(strFolder As String)
Dim objFS As Object, objFolder As Object, objItem As Object
Call Replace_Word(strFolder)
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolder)
For Each objItem In objFolder.SubFolders
Call View_Folder(objItem.Path)
Next objItem
Set objFolder = Nothing
Set objFS = Nothing
End Function
Function Replace_Word(strFolder As String)
Dim objFS As Object, objFolder As Object, objItem As Object
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolder)
For Each objItem In objFolder.Files
If StrComp(objFS.GetExtensionName(objItem.Name), "txt", vbTextCompare) = 0 Then 'расширение фалов укажите своё
'здесь должен быть код для выполнения замены слова
End If
Next objItem
Set objFolder = Nothing
Set objFS = Nothing
End Function
1) A(i)="..." - это пути к подпапкам;
2) 20 - да, здесь я имел в виду примерное количество, подпапок, так как ты не указал точное;
3) Если ты не знаешь количество строк в файле, то, естественно, у тебя нет другого варианта, кроме того, как воспользоваться функцией EOF;
B(j)-это массив строк из файла, без него ни как!
4) Нужно всё-таки сначала закрыть файл, а потом его снова открыть для записи - так надёжнее! Но я бы в данном случае не стал бы "лепить горбатого" :D и всё это вынес бы в отдельную процедуру:
Что-то типа того! :o
А процедуру записи в файл нужно применить только тогда, когда закончиться цикл For i .... Next i.
Кстати, можешь сравнить, два предложенных метода решения этой задачи - мой и рекурсионный (тот, что предложил dmitrii). Сделав, заранее пару копий испытуемых файлов! :D
А потом сообщишь о результатах: о правильности работы программ, затраченном времени на обработку, и т. п.
2) 20 - да, здесь я имел в виду примерное количество, подпапок, так как ты не указал точное;
3) Если ты не знаешь количество строк в файле, то, естественно, у тебя нет другого варианта, кроме того, как воспользоваться функцией EOF;
B(j)-это массив строк из файла, без него ни как!
4) Нужно всё-таки сначала закрыть файл, а потом его снова открыть для записи - так надёжнее! Но я бы в данном случае не стал бы "лепить горбатого" :D и всё это вынес бы в отдельную процедуру:
Код:
Dim str1 As String
Dim str2 As String
Dim B(1 To 1000) As String
...
If Instr(B(j), "Любой")>0 Then Substitution_Word
...
Private Sub Substitution_Word()
str1=Left(B(j), Instr(B(j), "Любой") - 1)
str2=Right(B(j)), Len(B(j)) - Instr(B(j), "Любой") - 4)
B(j)=str1 & "Any" & str2
End Sub
Dim str2 As String
Dim B(1 To 1000) As String
...
If Instr(B(j), "Любой")>0 Then Substitution_Word
...
Private Sub Substitution_Word()
str1=Left(B(j), Instr(B(j), "Любой") - 1)
str2=Right(B(j)), Len(B(j)) - Instr(B(j), "Любой") - 4)
B(j)=str1 & "Any" & str2
End Sub
Что-то типа того! :o
А процедуру записи в файл нужно применить только тогда, когда закончиться цикл For i .... Next i.
Кстати, можешь сравнить, два предложенных метода решения этой задачи - мой и рекурсионный (тот, что предложил dmitrii). Сделав, заранее пару копий испытуемых файлов! :D
А потом сообщишь о результатах: о правильности работы программ, затраченном времени на обработку, и т. п.
Отчет (предварительный, до рекурсии пока не дошел).
Вот что написалось (за 2 часа):
уффф. "Еще две тысячи ведер - и Золотой Ключик у нас (у меня) в кармане".
Вот что написалось (за 2 часа):
Код:
'[COLOR="DarkGreen"]... на "точках" шло перечисление папок, где менять[/COLOR]
For i = 1 To 10 'цикл на перебор папок
iPath$ = A(i)
iFileName$ = Dir(iPath$ & "*.*")
Do While iFileName$ <> ""[COLOR="DarkGreen"] 'цикл на перебор файлов[/COLOR]
Open A(i) & "\" & iFileName$ For Input As #1
j = 1
Do While Not EOF(1) [COLOR="DarkGreen"]' цикл на перебор строк в открытом файле[/COLOR]
'For j = 1 To 550 ' максимальное количество строк в файлах.
Line Input #1, TL(j) [COLOR="DarkGreen"]' считываем строку в "массивную" переменную[/COLOR]
c = InStr(TL(j), "press") [COLOR="DarkGreen"]'номер символа, с которого начинается совпадение[/COLOR]
'поменял искомое слово, т.к. это встречается в самом первом файле в самой первой строке (чтобы побыстрее отлаживать, хотя можно было бы помощью клавиши F9 назначать точку отладочной остановки).
If InStr(TL(j), "press") > 0 Then [COLOR="DarkGreen"]'Substitution_Word - пока проще оказалось "налепить горбатого" [/COLOR]
str1 = Mid(TL(j), 1, c - 1)
str2 = Mid(TL(j), c, Len(str1) - 1)
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(str2))
NewTxt = str1 & "ХХХХХХ" & str3
End If
j = j + 1
Loop
Close #1 'сформировали окончательную "массивную" переменную
'в которой должен сидеть все содержимое обработанного файла
Open A(i) & "\" & iFileName$ For Output As #1
Write #1, TL() 'вот тут все останавливается со словами [COLOR="Red"]TYPE MISMATCH[/COLOR]
'[COLOR="Navy"]Т.е. как теперь записать-то
'эту массивную переменную в файл,
'т.е. заменить содержимое файла с кусочком нового текста ?[/COLOR][/COLOR]
Close #1
[COLOR="DarkGreen"]' закончили цикл на перебор строк в открытом файле[/COLOR]
Loop ' закончили цикл на перебор файлов
Next i ' закончили цикл на перебор папок
End Sub
For i = 1 To 10 'цикл на перебор папок
iPath$ = A(i)
iFileName$ = Dir(iPath$ & "*.*")
Do While iFileName$ <> ""[COLOR="DarkGreen"] 'цикл на перебор файлов[/COLOR]
Open A(i) & "\" & iFileName$ For Input As #1
j = 1
Do While Not EOF(1) [COLOR="DarkGreen"]' цикл на перебор строк в открытом файле[/COLOR]
'For j = 1 To 550 ' максимальное количество строк в файлах.
Line Input #1, TL(j) [COLOR="DarkGreen"]' считываем строку в "массивную" переменную[/COLOR]
c = InStr(TL(j), "press") [COLOR="DarkGreen"]'номер символа, с которого начинается совпадение[/COLOR]
'поменял искомое слово, т.к. это встречается в самом первом файле в самой первой строке (чтобы побыстрее отлаживать, хотя можно было бы помощью клавиши F9 назначать точку отладочной остановки).
If InStr(TL(j), "press") > 0 Then [COLOR="DarkGreen"]'Substitution_Word - пока проще оказалось "налепить горбатого" [/COLOR]
str1 = Mid(TL(j), 1, c - 1)
str2 = Mid(TL(j), c, Len(str1) - 1)
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(str2))
NewTxt = str1 & "ХХХХХХ" & str3
End If
j = j + 1
Loop
Close #1 'сформировали окончательную "массивную" переменную
'в которой должен сидеть все содержимое обработанного файла
Open A(i) & "\" & iFileName$ For Output As #1
Write #1, TL() 'вот тут все останавливается со словами [COLOR="Red"]TYPE MISMATCH[/COLOR]
'[COLOR="Navy"]Т.е. как теперь записать-то
'эту массивную переменную в файл,
'т.е. заменить содержимое файла с кусочком нового текста ?[/COLOR][/COLOR]
Close #1
[COLOR="DarkGreen"]' закончили цикл на перебор строк в открытом файле[/COLOR]
Loop ' закончили цикл на перебор файлов
Next i ' закончили цикл на перебор папок
End Sub
уффф. "Еще две тысячи ведер - и Золотой Ключик у нас (у меня) в кармане".
А ты обратил внимание на эту фразу:
Цитата:
А процедуру записи в файл нужно применить только тогда, когда закончиться цикл For i .... Next i.
Дело в том, что на момент записи переменная j уже больше 550, а значения у переменной TL(551) нет, поэтому он и выдаёт ошибку Type Mismatch! Чтобы исключить это я и предложил операцию записи в файл сделать отдельно, т. к. там будет нужно использовать отдельный цикл. И в этом случае использовать дополнительную переменную (NewTxt) бессмысленно, т. к. есть массив переменных TJ(), поэтому необходимо заменить строку NewTxt = str1 & "ХХХХХХ" & str3 на TJ(j) = str1 & "ХХХХХХ" & str3 и записывать в файл TJ().
Да уж задал размерность TL как "безразмерная". Т.е. объявил
Dim TL(), а не Dim TL(1 to 550)
И подправил вот так:
[COLOR="DarkGreen"]'NewTxt = str1 & "RRRR" & str3[/COLOR]
[COLOR="Navy"]TL(j) = str1 & "RRRR" & str3[/COLOR]
И в конце этого цикла (по перебору строк) переменная заполняется массивом строк, в которых, если было искомое слово, то оно уже заменено на новый вариант RRRR.
Но как только надо записать эту "набитую" строками переменную TL в файл (командой Write #1, TL()), то опять "претензия" к ее типу. Может просто неправильно оформляю команду на запись? Т.е. как вообще пишется инструкция "записать в файл "массивную" текстовую переменную"?
А то строки насобирал, а записать не могу.
А если дать команду на запись как Write #1, TL(j), то будет писать только одна строка вместо всех вместе взятых. Тут же нет возможности замены отдельной строки. Меняется либо все содержимое, либо дописывается в конец. Т.е. построчно записывать не получится (если я правильно понимаю "теорию относительности" ;-)).
Dim TL(), а не Dim TL(1 to 550)
И подправил вот так:
[COLOR="DarkGreen"]'NewTxt = str1 & "RRRR" & str3[/COLOR]
[COLOR="Navy"]TL(j) = str1 & "RRRR" & str3[/COLOR]
И в конце этого цикла (по перебору строк) переменная заполняется массивом строк, в которых, если было искомое слово, то оно уже заменено на новый вариант RRRR.
Но как только надо записать эту "набитую" строками переменную TL в файл (командой Write #1, TL()), то опять "претензия" к ее типу. Может просто неправильно оформляю команду на запись? Т.е. как вообще пишется инструкция "записать в файл "массивную" текстовую переменную"?
А то строки насобирал, а записать не могу.
А если дать команду на запись как Write #1, TL(j), то будет писать только одна строка вместо всех вместе взятых. Тут же нет возможности замены отдельной строки. Меняется либо все содержимое, либо дописывается в конец. Т.е. построчно записывать не получится (если я правильно понимаю "теорию относительности" ;-)).
Попробуй вместо Dim TL() - Dim TL(1 To 550) или даже с запасом, например, Dim TL(1 To 1000). Я думаю, причина ошибки именно в этом, т. к. Basic не очень любит такие штуки, как "безразмерный" массив! А записать в файл значения массива TJ(), на мой взгляд, очень просто:
Насколько я знаю, построчно записывать в файл Basic не может :( , поэтому нужно записывать весь массив! :cool:
Код:
Open A(i) & "\" & iFileName$ For Output As #1
For i=1 To j-1
Write #1, TJ(i)
Next i
Close #1
For i=1 To j-1
Write #1, TJ(i)
Next i
Close #1
Насколько я знаю, построчно записывать в файл Basic не может :( , поэтому нужно записывать весь массив! :cool:
Пришлось подставить инструкцию On Error, потому что при попытке записать строку с номером, большим чем есть в файле, выдает ошибку. Поэтому и хотел, что бы было условие по EOF. Но так тоже можно:
Тольк не пойму, почему все строки в переписанном файле оказались в кавычках? А за подсказочку как записать массивную переменную в файл - спасибо (и за остальное тоже :) ).
Кстати, пока пишу ответ, оно крутится и покажет суммарное время. Будет интересно потом сравнить с др. вариантом кода.
Код:
For j = 1 To 550 'тысячу не стал писать, что бы не грузить программу, да и при отладке чуть дольше открывается переменная для просмотра.
On Error Resume Next
Line Input #1, TL(j) ' считываем строку в переменную
If InStr(TL(j), "press") > 0 Then 'Substitution_Word
c = InStr(TL(j), "press") 'номер символа, с которого начинается совпадение
str1 = Mid(TL(j), 1, c - 1)
str2 = Mid(TL(j), c, Len(str1) - 1)
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(str2))
'NewTxt = str1 & "RRRR" & str3
TL(j) = str1 & "RRRR" & str3
End If
Next j ' закончили цикл на перебор строк в открытом файле
''j = j + 1
''Loop
sk:
Close #1
Open A(i) & "\" & iFileName$ For Output As #1
For j = 1 To j - 1
Write #1, TL(j)
Next j
Close #1
' закончили цикл на перебор строк в открытом файле
On Error Resume Next
Line Input #1, TL(j) ' считываем строку в переменную
If InStr(TL(j), "press") > 0 Then 'Substitution_Word
c = InStr(TL(j), "press") 'номер символа, с которого начинается совпадение
str1 = Mid(TL(j), 1, c - 1)
str2 = Mid(TL(j), c, Len(str1) - 1)
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(str2))
'NewTxt = str1 & "RRRR" & str3
TL(j) = str1 & "RRRR" & str3
End If
Next j ' закончили цикл на перебор строк в открытом файле
''j = j + 1
''Loop
sk:
Close #1
Open A(i) & "\" & iFileName$ For Output As #1
For j = 1 To j - 1
Write #1, TL(j)
Next j
Close #1
' закончили цикл на перебор строк в открытом файле
Тольк не пойму, почему все строки в переписанном файле оказались в кавычках? А за подсказочку как записать массивную переменную в файл - спасибо (и за остальное тоже :) ).
Кстати, пока пишу ответ, оно крутится и покажет суммарное время. Будет интересно потом сравнить с др. вариантом кода.
Не получается обходить ошибку. Вернее ошибка обходится, но из-за этого в любой файл записывается строго 550 строк (ессно, с пустыми кавычками). Т.е. мне надо будет сообразить, как обрабатывать реальное кол-во имеющихся строк. :(
Если точное количество сторок в файлах не известно, то лучше всё-таки использовать фунцию EOF(). На момент выхода из цикла Do While... Loop значение переменной j должно соответствовать количеству строк в данном файле, что, в свою очередь, пригодится при записи в файл! А чтобы записать в файл строку без кавычек нужно вместо Write #1 использовать Print #1.
Тут такая проблема вылезла. Файлы без расширения не воспринимаются как объекты воздействия. А у 3/4 всех файлов без расширения. Хотя можно им повесить расширения, но это довольно нудное дело. Хотя и не оч. долго, но хотелось обрабатывать все это как есть, без доп. манипуляций.
А по времени получилось на не целероновской машине в 1 Ггц 180 файлов обработались меньше чем за сек. Т.е. все оч. быстро.
И другая проблема выскочила. Если строка содержит только одно слово, и я его хочу заменить (но это уже скорее из области чистого эксперимента, т.к. строки с одним словом менять мне не надо будет. Но для очистки совести можно ли что-то придумать?). Т.е. если слово в строке одно [COLOR="Navy"](вернее, если совпадение начинается с первого же символа)[/COLOR], то происходит остановка на str2 (потому что str1 оказывается пустой, что естественно. Нельзя же разбить строку из одного слова на три части - "до совпадения", "совпадение" и "после совпадения").
str1 = Mid(TL(j), 1, c - 1) 'часть до совпадения
str2 = Mid(TL(j), c, Len(str1) - 1) 'часть совпадения
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(str2)) 'часть после совпадения
Вот можно ли как-то обойти эту трудность?
Большое спасибо за помощь.
(P.S. если я поднадоел со своими экспериментами, то можно плюнуть, тк. эта часть вопроса не принципиальная, ведь частичные совпадения текста уже меняются и расширения я тоже могу приписать). Т.е. в целом задача и так решена (остались лишь противные нюансы :o ).
А по времени получилось на не целероновской машине в 1 Ггц 180 файлов обработались меньше чем за сек. Т.е. все оч. быстро.
И другая проблема выскочила. Если строка содержит только одно слово, и я его хочу заменить (но это уже скорее из области чистого эксперимента, т.к. строки с одним словом менять мне не надо будет. Но для очистки совести можно ли что-то придумать?). Т.е. если слово в строке одно [COLOR="Navy"](вернее, если совпадение начинается с первого же символа)[/COLOR], то происходит остановка на str2 (потому что str1 оказывается пустой, что естественно. Нельзя же разбить строку из одного слова на три части - "до совпадения", "совпадение" и "после совпадения").
str1 = Mid(TL(j), 1, c - 1) 'часть до совпадения
str2 = Mid(TL(j), c, Len(str1) - 1) 'часть совпадения
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(str2)) 'часть после совпадения
Вот можно ли как-то обойти эту трудность?
Большое спасибо за помощь.
(P.S. если я поднадоел со своими экспериментами, то можно плюнуть, тк. эта часть вопроса не принципиальная, ведь частичные совпадения текста уже меняются и расширения я тоже могу приписать). Т.е. в целом задача и так решена (остались лишь противные нюансы :o ).
Сам же и ответил:
Надо просто приписать условие, если совпадение начинается с первого символа
Не прошло и часа.
Надо просто приписать условие, если совпадение начинается с первого символа
Код:
finn = "return"
chan = "QQQQQQQQQQQQQQQ"
Line Input #1, TL(j) ' считываем строку в переменную
If InStr(TL(j), finn) > 0 Then 'Substitution_Word
c = InStr(TL(j), finn) 'номер символа, с которого начинается совпадение
If c = 1 Then
str1 = ""
Else
str1 = Mid(TL(j), 1, c - 1)
End If
str2 = finn
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(finn))
TL(j) = str1 & chan & str3
End If
'Next j ' закончили цикл на перебор строк в открытом файле
j = j + 1
Loop ' закончили цикл на перебор строк в открытом файле
sk:
Close #1
chan = "QQQQQQQQQQQQQQQ"
Line Input #1, TL(j) ' считываем строку в переменную
If InStr(TL(j), finn) > 0 Then 'Substitution_Word
c = InStr(TL(j), finn) 'номер символа, с которого начинается совпадение
If c = 1 Then
str1 = ""
Else
str1 = Mid(TL(j), 1, c - 1)
End If
str2 = finn
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(finn))
TL(j) = str1 & chan & str3
End If
'Next j ' закончили цикл на перебор строк в открытом файле
j = j + 1
Loop ' закончили цикл на перебор строк в открытом файле
sk:
Close #1
Не прошло и часа.
Dmitry2064, если Вам надо обработать файлы только [color=blue]TXT[/color]-формата, если в них нет ошибок или их наличие учитывать не требуется, то процедура замены текста может выглядеть так:
Если же требуется учитывать наличие ошибок, то, вероятно, без регулярных выражений Вам не обойтись.
Код:
Sub Example()
Dim objFS As Object, objFile As Object
Dim strPath As String, strText As String
Const ForReading = 1, ForWriting = 2
strPath = "C:\Temp\Any.txt"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.OpenTextFile(strPath, ForReading)
strText = objFile.ReadAll
objFile.Close
strText = replace(strText, "Любой", "Any ")
strText = replace(strText, "любой", "any")
Set objFile = objFS.OpenTextFile(strPath, ForWriting, True)
objFile.Write(strText)
objFile.Close
Set objFile = Nothing
Set objFS = Nothing
End Sub
Dim objFS As Object, objFile As Object
Dim strPath As String, strText As String
Const ForReading = 1, ForWriting = 2
strPath = "C:\Temp\Any.txt"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.OpenTextFile(strPath, ForReading)
strText = objFile.ReadAll
objFile.Close
strText = replace(strText, "Любой", "Any ")
strText = replace(strText, "любой", "any")
Set objFile = objFS.OpenTextFile(strPath, ForWriting, True)
objFile.Write(strText)
objFile.Close
Set objFile = Nothing
Set objFS = Nothing
End Sub
Если же требуется учитывать наличие ошибок, то, вероятно, без регулярных выражений Вам не обойтись.
Цитата: Dmitrii
Dmitry2064
End Sub
[/code]
Если же требуется учитывать наличие ошибок, то, вероятно, без регулярных выражений Вам не обойтись.
End Sub
[/code]
Если же требуется учитывать наличие ошибок, то, вероятно, без регулярных выражений Вам не обойтись.
Вот что я сообразил, когда читал учебник о VBA про подстановочные символы для оператора Like (хотя это должно было быть очевидно). Как можно оч. быстро обойти проблему с обработкой расширений [COLOR="Indigo"](у меня большинство файлов со PM-скриптами находится в файлах без расширения, потому что из экономии времени я в Total Commander'e нажимаю Shift-F4 и просто пишу имя нового файла скрипта, а расширение просто не вписываю, тк. долго. Для PageMaker'a расширения файлов скриптов не обязательны)[/COLOR].
Вот кусочек кода:
Код:
...
iFileName$ = Dir(iPath$ & "*")
[COLOR="DarkGreen"]''''а было Dir(iPath$ & "*.*")[/COLOR]
Do While iFileName$ <> "" 'цикл на перебор файлов
Open A(i) & "\" & iFileName$ For Input As #1
...
iFileName$ = Dir(iPath$ & "*")
[COLOR="DarkGreen"]''''а было Dir(iPath$ & "*.*")[/COLOR]
Do While iFileName$ <> "" 'цикл на перебор файлов
Open A(i) & "\" & iFileName$ For Input As #1
...
Цитата: Dmitry2064
... у меня большинство файлов со PM-скриптами находится в файлах без расширения...
Для предложенного мной способа (замены строки) это условие не имеет никакого значения. Речь шла лишь о том, что обрабатываемые файлы должны иметь формат простого текстового файла Windows ("Только текст").
Что касается регулярных выражений, то я упомянул о них в связи с содержимым обрабатываемых файлов, а не в связи с их именами.
Цитата: Dmitrii
Для предложенного мной способа (замены строки) это условие не имеет никакого значения. Речь шла лишь о том, что обрабатываемые файлы должны иметь формат простого текстового файла Windows ("Только текст").
Понял, - важно не расширение, а тип содержимого. Да, они именно текстовые.
Цитата: Dmitrii
Что касается регулярных выражений, то я упомянул о них в связи с содержимым обрабатываемых файлов, а не в связи с их именами.
С regExp'ами знаком пока только понаслышке. И вроде они только в Перле или где-то "там" живут.
А пока получилось такая (наверное, довольно громоздкая) конструкция.
Код:
Sub TextChangeMore()
PodDir$ = "D:\Down\CPK\123\" [COLOR="DarkGreen"]'путь к папкам скриптов[/COLOR]
FoldSub (PodDir$) [COLOR="DarkGreen"]'запускаем подпрограмму удаления (см. ниже)[/COLOR]
End Sub
''''''подпрограмма
Private Sub FoldSub(fold)
Dim objFso, objFl, objSf, sF
Dim finn, chan As String
Dim TL(550) [COLOR="DarkGreen"]'если бы тут еще указывать массив без "запаса", а по факту получающегося размера, но пока не получилось - VB ругался на тип переменной.[/COLOR]
finn = "return" 'искомый фрагмент
chan = "QQQQQQQQQQQQQQQ" [COLOR="DarkGreen"]'для наглядности[/COLOR]
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFl = objFso.GetFolder(fold)
Set objSf = objFl.SubFolders
For Each sF In objSf
On Error Resume Next
iFileName$ = Dir(sF.Path & "\" & "*")
Do While iFileName$ <> "" [COLOR="DarkGreen"]'начали цикл на перебор файлов[/COLOR]
Open sF.Path & "\" & iFileName$ For Input As #1
j = 1
Do While Not EOF(1) [COLOR="DarkGreen"] ' цикл на перебор строк в открытом файле[/COLOR][COLOR="DarkGreen"]
Line Input #1, TL(j) [/COLOR]' считываем строку в переменную
If InStr(TL(j), finn) > 0 Then 'Substitution_Word
c = InStr(TL(j), finn) 'номер символа, с которого начинается совпадение
If c = 1 Then
str1 = ""
Else
str1 = Mid(TL(j), 1, c - 1)
End If
str2 = finn
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(finn))
TL(j) = str1 & chan & str3
End If
j = j + 1
Loop '[COLOR="DarkGreen"] закончили цикл на перебор строк в открытом файле[/COLOR]
sk: [COLOR="DarkGreen"]'кажется эта метка уже не нужна[/COLOR]
Close #1
Open sF.Path & "\" & iFileName$ For Output As #1
For j = 1 To j - 1
Print #1, TL(j)
Next j
Close #1
iFileName = Dir
Loop [COLOR="DarkGreen"]' закончили цикл на перебор файлов[/COLOR]
Call FoldSub(sF.Path)
Next
End Sub
PodDir$ = "D:\Down\CPK\123\" [COLOR="DarkGreen"]'путь к папкам скриптов[/COLOR]
FoldSub (PodDir$) [COLOR="DarkGreen"]'запускаем подпрограмму удаления (см. ниже)[/COLOR]
End Sub
''''''подпрограмма
Private Sub FoldSub(fold)
Dim objFso, objFl, objSf, sF
Dim finn, chan As String
Dim TL(550) [COLOR="DarkGreen"]'если бы тут еще указывать массив без "запаса", а по факту получающегося размера, но пока не получилось - VB ругался на тип переменной.[/COLOR]
finn = "return" 'искомый фрагмент
chan = "QQQQQQQQQQQQQQQ" [COLOR="DarkGreen"]'для наглядности[/COLOR]
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFl = objFso.GetFolder(fold)
Set objSf = objFl.SubFolders
For Each sF In objSf
On Error Resume Next
iFileName$ = Dir(sF.Path & "\" & "*")
Do While iFileName$ <> "" [COLOR="DarkGreen"]'начали цикл на перебор файлов[/COLOR]
Open sF.Path & "\" & iFileName$ For Input As #1
j = 1
Do While Not EOF(1) [COLOR="DarkGreen"] ' цикл на перебор строк в открытом файле[/COLOR][COLOR="DarkGreen"]
Line Input #1, TL(j) [/COLOR]' считываем строку в переменную
If InStr(TL(j), finn) > 0 Then 'Substitution_Word
c = InStr(TL(j), finn) 'номер символа, с которого начинается совпадение
If c = 1 Then
str1 = ""
Else
str1 = Mid(TL(j), 1, c - 1)
End If
str2 = finn
str3 = Right(TL(j), Len(TL(j)) - Len(str1) - Len(finn))
TL(j) = str1 & chan & str3
End If
j = j + 1
Loop '[COLOR="DarkGreen"] закончили цикл на перебор строк в открытом файле[/COLOR]
sk: [COLOR="DarkGreen"]'кажется эта метка уже не нужна[/COLOR]
Close #1
Open sF.Path & "\" & iFileName$ For Output As #1
For j = 1 To j - 1
Print #1, TL(j)
Next j
Close #1
iFileName = Dir
Loop [COLOR="DarkGreen"]' закончили цикл на перебор файлов[/COLOR]
Call FoldSub(sF.Path)
Next
End Sub
Ну и что в итоге, работает? ;)
Цитата: SPB-667
Ну и что в итоге, работает? ;)
Работает, но теперь выяснилось, что в строке может встречаться дважды заменяемое слово, например:
fillandline 2, "Black", 0, onepoint, 0, -2, 0, "Black", 1, 20, 0
Тогда, видимо, надо просто прогнать процедуру 2 раза.