| Цитата |
|---|
| написал: Код в сообщении следует оформлять с помощью кнопки . Вместо выделения цветом достаточно написать: "Заменить везде NodeLocation" |
| Код |
|---|
Sub Replace_xml()
Dim xmlDoc
Dim iTrek
With Application.FileDialog(msoFileDialogOpen)
If .Show = 0 Then MsgBox "Файл не выбран!", 64, "ошибка": Exit Sub
iTrek = .SelectedItems(1)
End With
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = False
xmlDoc.validateOnParse = False
strFilePath = iTrek
xmlDoc.Load (strFilePath)
Dim objListOfNodes
xmlDoc.setProperty "SelectionLanguage", "XPath"
XPath = "//Start"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set StartNode = objListOfNodes(n)
StartText = StartNode.Text
If InStr(1, StartText, "-", vbTextCompare) > 0 Then
StartR = Split(StartText, "-")
StartNode.Text = StartR(1) & " " & StartR(0)
End If
Next
XPath = "//End"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set EndNode = objListOfNodes(n)
EndText = EndNode.Text
If InStr(1, EndText, "-", vbTextCompare) > 0 Then
EndR = Split(EndText, "-")
EndNode.Text = EndR(1) & " " & EndR(0)
End If
Next
XPath = "//PI"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set PINode = objListOfNodes(n)
PIText = PINode.Text
If InStr(1, PIText, "-", vbTextCompare) > 0 Then
PIR = Split(PIText, "-")
PINode.Text = PIR(1) & " " & PIR(0)
End If
Next
XPath = "//Center"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set CenterNode = objListOfNodes(n)
CenterText = CenterNode.Text
If InStr(1, CenterText, "-", vbTextCompare) > 0 Then
CenterR = Split(CenterText, "-")
CenterNode.Text = CenterR(1) & " " & CenterR(0)
End If
Next
XPath = "//NodeLocation"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set NodeLocationNode = objListOfNodes(n)
NodeLocationText = NodeLocationNode.Text
If InStr(1, NodeLocationText, "-", vbTextCompare) > 0 Then
NodeLocationR = Split(NodeLocationText, "-")
NodeLocationNode.Text = NodeLocationR(1) & " " & NodeLocationR(0)
End If
Next
XPath = "//Point"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set PointNode = objListOfNodes(n)
PointText = PointNode.Text
If InStr(1, PointText, "-", vbTextCompare) > 0 Then
PointR = Split(PointText, "-")
PointNode.Text = PointR(1) & " " & PointR(0)
End If
Next
xmlDoc.Save strFilePath
End Sub |
при запуске спрашивает где лежит файл и сразу его меняет!!!!
Все действия проводите только после создания копии.
Изменено: - 13.10.2017 13:44:50
(английский в школе мимо меня прошел 
)
Файл примера в тхт но по факту это XML. ( который должен быть еще и в строчку записан.)
Всем Спасибо это мой второй макрос.