Есть работающий макрос, который изменяет строку в конкретно указанном xml файле. Однако таких файлов очень много, поэтому требуется макрос, работающий со всеми xml файлами в папке. Адрес папки известен, все имеющиеся там файлы нужно обработать таким образом.
Операционная система: Windows 7.
Макрос
Public Sub ReplaceStringInFile()
Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As String
'Путь к файлу
sFileName = "C:\Users\User\Desktop\1\80020_0264004103_20190630_215_0000000001.xml"
iFileNum = FreeFile
Open sFileName For Input As iFileNum
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
sTemp = Replace(sTemp, "<daylightsavingtime>1</daylightsavingtime>", "<daylightsavingtime>0</daylightsavingtime>")
iFileNum = FreeFile
Open sFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
End Sub
1. Это код для виндоуса. Для мака нужно писать другой код.
2. Вверху модуля вставьте эти строки:
Option Explicit
Option Compare Text
Option Base 1
3. Подключите библиотеку:
Tools - References... - Microsoft Scripting Runtime
4. В процедуре "ПолучитьПолныеИмена":
1) в пункте 2 укажите полное имя (путь + имя) папки, которую надо просмотреть. На конце слеш не указывайте;
2) в пункте 4, справа от "Case" укажите нужные расширения через запятую, как сейчас сделано.
Макрос
Sub Макрос()
Dim FNs As Collection
Dim i As Long
'1. Записываем в коллекцию "FNs" полные имена файлов, которые находятся
' в указанной папке
ПолучитьПолныеИмена FNs
'2. Работа с файлами.
For i = 1 To FNs.Count
ReplaceStringInFile FNs(i)
Next i
'3. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Private Sub ПолучитьПолныеИмена(FNs As Collection)
Dim fso As Scripting.FileSystemObject
Dim папка As Scripting.Folder, файл As Scripting.File
'1. Создание объекта, который умеет работать с папками и файлами.
Set fso = New FileSystemObject
'2. Присваиваем имя папке, с которой надо работать.
' Здесь укажите полное имя папки. На конце слеш не нужно указывать.
Set папка = fso.GetFolder("C:\Users\User\Desktop\Файлы")
'3. Создание коллекции.
Set FNs = New Collection
'4. Запись в коллекцию полных имён файлов, которые находятся в указанной папке.
' Если эксель-файл открыт, то в папке будет скрытый файл, относящийся к этому файлу.
' Поэтому делается проверка, что файл не скрытый.
For Each файл In папка.Files
If (файл.Attributes And Hidden) = 0 Then
Select Case Mid(файл.Name, InStrRev(файл.Name, ".") + 1)
Case "xlsb", "xlsx"
FNs.Add item:=файл.Path
End Select
End If
Next файл
End Sub
Private Sub ReplaceStringInFile(FN As String)
Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
iFileNum = FreeFile
Open FN For Input As iFileNum
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
sTemp = Replace(sTemp, "<daylightsavingtime>1</daylightsavingtime>", "<daylightsavingtime>0</daylightsavingtime>")
iFileNum = FreeFile
Open FN For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
End Sub