Скажем, у меня есть следующая страница, сохраненная в c: \ temp \ html_page.html:

<html>
   <head>
      <link rel="stylesheet" href="styles.css">
   </head>
   <body>
      <div id="xxx1">
         <img src="test.png">
      </div>
   </body>
</html>

Я хотел бы программно настроить атрибут src img на основе данных Excel и VBA. В основном это способ найти div с помощью Xpath и настроить (одиночный) тег img, который в нем содержится.

Я нашел пример управления XML с помощью VBA через библиотеку XML здесь, но я ломал голову над тем, как заставить эту работу работать с библиотекой объектов HTML; не могу найти никаких примеров и / или документации.

Dim XDoc As Object, root As Object

Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False: XDoc.validateOnParse = False

If XDoc.Load(html_path) Then
    Debug.Print "Document loaded"
Else
    Dim strErrText As String
    Dim xPE As MSXML2.IXMLDOMParseError
    ' Obtain the ParseError object
    Set xPE = XDoc.parseError
    With xPE
       strErrText = "Your XML Document failed to load" & _
         "due the following error." & vbCrLf & _
         "Error #: " & .ErrorCode & ": " & xPE.reason & _
         "Line #: " & .Line & vbCrLf & _
         "Line Position: " & .linepos & vbCrLf & _
         "Position In File: " & .filepos & vbCrLf & _
         "Source Text: " & .srcText & vbCrLf & _
         "Document URL: " & .URL
    End With
    MsgBox strErrText, vbExclamation

Все, что я хочу сделать, это:

'...
Set outer_div = XDoc.SelectFirstNode("//div[id='xxx1'")
... edit the img attribute

Но я не могу загрузить HTML-страницу, потому что это неправильный XML (тег img не закрыт).

Любая помощь приветствуется. О, и я не могу использовать другие языки, такие как Python, облом.

4
MattV 25 Ноя 2016 в 15:37

2 ответа

Лучший ответ

Это не совсем то, что вам нужно, но может быть достаточно близко. Вместо использования библиотеки XML используйте библиотеку HTML:

Sub changeImg()

    Dim dom As Object
    Dim img As Object
    Dim src As String

    Set dom = CreateObject("htmlFile")

    Open "C:\temp\test.html" For Input As #1
        src = Input$(LOF(1), 1)
    Close #1

    dom.body.innerHTML = src

    Set img = dom.getelementsbytagname("img")(0)

    img.src = "..."

    Open "C:\temp\test.html" For Output As #1
        Print #1, dom.DocumentElement.outerHTML
    Close #1


End Sub

Проблема в том, что в результирующий файл будет добавлено Head узлов, а имена тегов будут в верхнем регистре. Если вы можете смириться с этим, решение будет работать для вас.

В стороне, если вы хотите сделать что-то более детально, с лучшими селекторами рассмотрите возможность раннего связывания. Отображаемый HTML-интерфейс отличается от интерфейса при позднем связывании и поддерживает больше свойств - вам нужно добавить ссылку на HTML Object Library:

Sub changeImg()

    Dim dom As HTMLDocument
    Dim img As Object
    Dim src As String

    Set dom = CreateObject("htmlFile")

    Open "C:\temp\test.html" For Input As #1
        src = Input$(LOF(1), 1)
    Close #1

    dom.body.innerHTML = src

    Set img = dom.getelementsbytagname("img")(0)

    img.src = "..."

    Open "C:\temp\test.html" For Output As #1
        Print #1, dom.DocumentElement.outerHTML
    Close #1


End Sub
3
SWa 25 Ноя 2016 в 13:06

Для этого вы можете использовать doc.querySelector("div[id='xxx1'] img"). Чтобы изменить атрибут src, используйте img.setAttribute "src", "new.png". HTH

Option Explicit

' Add reference to Microsoft Internet Controls (SHDocVw)
' Add reference to Microsoft HTML Object Library

Sub Demo()
    Dim ie As SHDocVw.InternetExplorer
    Dim doc As MSHTML.HTMLDocument
    Dim url As String

    url = "file:///C:/Temp/StackOverflow/html/html_page.html"
    Set ie = New SHDocVw.InternetExplorer
    ie.Visible = True
    ie.navigate url
    While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE: DoEvents: Wend
    Set doc = ie.document

    Dim img As HTMLImg
    Set img = doc.querySelector("div[id='xxx1'] img")
    If Not img Is Nothing Then
        img.setAttribute "src", "new.png"
    End If
    ie.Quit
End Sub
1
Daniel Dušek 26 Ноя 2016 в 09:06