在Excel VBA中获取图像url

发布于 2025-01-15 08:13:24 字数 1220 浏览 2 评论 0原文

我需要获取图像的网址，我不需要图像本身，我只需要网址。但我无法让它发挥作用。

这是网站：https://www.bauhaus.com.tr/hirdavat-hirdavat-urunleri-menteseler-mobilya-menteseleri/adilon-karyola-demiri-61185746

我没有编码经验，所以如果有更简单的方式请分享。这是代码：

Dim i, sonsat As Integer
Dim url As String
Dim XMLreq As New MSXML2.XMLHTTP60
Dim HTMLdoc As New MSHTML.HTMLDocument

sonsat = Sheets("Sayfa1").Range("A10000").End(xlUp).Row

For i = 2 To sonsat
On Error Resume Next

url = Sheets("Sayfa1").Range("A" & i)

XMLreq.Open "GET", url, False
XMLreq.send


If XMLreq.Status <> 200 Then

MsgBox "Sayfaya Ulaşılamadı"
Exit Sub

End If

HTMLdoc.body.innerHTML = XMLreq.responseText


Sheets("Sayfa1").Range("C" & i) = HTMLdoc.getElementsByClassName("title")(0).innerText
Sheets("Sayfa1").Range("B" & i) = HTMLdoc.getElementsByClassName("title sub")(0).innerText
Sheets("Sayfa1").Range("D" & i) = HTMLdoc.getElementsByClassName("proAttr sku")(0).innerText
Sheets("Sayfa1").Range("E" & i) = HTMLdoc.getElementsByclassName("item")(391).innerText



Next



End Sub

原文

I need to get the url of the image, i don't need the image itself i just need url. But i can't get it to work.

Here's the site: https://www.bauhaus.com.tr/hirdavat-hirdavat-urunleri-menteseler-mobilya-menteseleri/adilon-karyola-demiri-61185746

I have no experience in coding, so if there's an easier way please share it.
Here's the code:

Dim i, sonsat As Integer
Dim url As String
Dim XMLreq As New MSXML2.XMLHTTP60
Dim HTMLdoc As New MSHTML.HTMLDocument

sonsat = Sheets("Sayfa1").Range("A10000").End(xlUp).Row

For i = 2 To sonsat
On Error Resume Next

url = Sheets("Sayfa1").Range("A" & i)

XMLreq.Open "GET", url, False
XMLreq.send


If XMLreq.Status <> 200 Then

MsgBox "Sayfaya Ulaşılamadı"
Exit Sub

End If

HTMLdoc.body.innerHTML = XMLreq.responseText


Sheets("Sayfa1").Range("C" & i) = HTMLdoc.getElementsByClassName("title")(0).innerText
Sheets("Sayfa1").Range("B" & i) = HTMLdoc.getElementsByClassName("title sub")(0).innerText
Sheets("Sayfa1").Range("D" & i) = HTMLdoc.getElementsByClassName("proAttr sku")(0).innerText
Sheets("Sayfa1").Range("E" & i) = HTMLdoc.getElementsByclassName("item")(391).innerText



Next



End Sub

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

浪漫人生路 2025-01-22 08:13:24

您的代码大致正确，但事实证明图像是在页面加载后插入的，可能是由 JavaScript 组件插入的。因此，当您获取文档时，它不包含图像灯箱。

但是，该图像在页面元数据中被引用为

<html>
  <head>
    ...
    <meta property="og:image" content="https://...">
    ...
  </head>
...
</html>

因此您可以从那里提取它。

还有一些关于干净编码的建议：

当您在循环中运行时，最好每次都创建 HTML 文档和 XML HTTP Request 对象（将 New MSXML2.XMLHTTP60 和 New MSHTML. HTMLDocument 在循环内）
HTMLDocument 使用后应该关闭

所以这是一段非常接近您的最终要求的代码（我只是改变了循环，所以我不必重新制作你的 Excel 工作簿在我的侧面：

Sub testHtml()

    Dim i As Integer, j As Integer
    Dim url As String
    Dim XMLreq As MSXML2.XMLHTTP60
    Dim HTMLdoc As MSHTML.HTMLDocument
    Dim els As Variant 'DispHTMLElementCollection
    Dim meta As MSHTML.HTMLMetaElement
    
    'Replace following loop with your own (looping over worksheet column)
    For i = 1 To 3
        
        'You should actually read this url from your worksheet
        url = "https://www.bauhaus.com.tr/hirdavat-hirdavat-urunleri-menteseler-mobilya-menteseleri/adilon-karyola-demiri-61185746"
        
        Set XMLreq = New MSXML2.XMLHTTP60
        XMLreq.Open "GET", url, False
        XMLreq.send
    
        If XMLreq.Status <> 200 Then
            MsgBox "Error!"
            Exit Sub
        End If
        Set HTMLdoc = New MSHTML.HTMLDocument
        HTMLdoc.body.innerHTML = XMLreq.responseText
        
        Set els = HTMLdoc.getElementsByTagName("meta")
        'Debug.Print els.Length
        For j = 0 To els.Length - 1
            Set meta = els(j)
            'Debug.Print meta.outerHTML
            If meta.getAttribute("property") = "og:image" Then
                Debug.Print meta.Content 'Output to Execution Window
                'You should output to your WorkSheet instead
                Exit For
            End If
        Next j
        
        HTMLdoc.Close
    Next i
    
End Sub

最后一点：要查看 Debug.Print 的输出，请使用 VBA 中的执行窗口

Your code is about right, but it turns out the image is inserted after page load, probably by a JavaScript component. So when you get the document, it does not contain the image lightbox.

However, the image is referenced in the page metadata as

<html>
  <head>
    ...
    <meta property="og:image" content="https://...">
    ...
  </head>
...
</html>

So you can pull it from there.

Also some advice about clean coding:

As you're running in a loop, the HTML document and XML HTTP Request objects would better be created each time (put New MSXML2.XMLHTTP60 and New MSHTML.HTMLDocument inside the loop)
HTMLDocument should be closed after use

So here's a piece of code very close to your final requirements (I just changed the loop so I didn't have to re-make your Excel Workbook on my side:

Sub testHtml()

    Dim i As Integer, j As Integer
    Dim url As String
    Dim XMLreq As MSXML2.XMLHTTP60
    Dim HTMLdoc As MSHTML.HTMLDocument
    Dim els As Variant 'DispHTMLElementCollection
    Dim meta As MSHTML.HTMLMetaElement
    
    'Replace following loop with your own (looping over worksheet column)
    For i = 1 To 3
        
        'You should actually read this url from your worksheet
        url = "https://www.bauhaus.com.tr/hirdavat-hirdavat-urunleri-menteseler-mobilya-menteseleri/adilon-karyola-demiri-61185746"
        
        Set XMLreq = New MSXML2.XMLHTTP60
        XMLreq.Open "GET", url, False
        XMLreq.send
    
        If XMLreq.Status <> 200 Then
            MsgBox "Error!"
            Exit Sub
        End If
        Set HTMLdoc = New MSHTML.HTMLDocument
        HTMLdoc.body.innerHTML = XMLreq.responseText
        
        Set els = HTMLdoc.getElementsByTagName("meta")
        'Debug.Print els.Length
        For j = 0 To els.Length - 1
            Set meta = els(j)
            'Debug.Print meta.outerHTML
            If meta.getAttribute("property") = "og:image" Then
                Debug.Print meta.Content 'Output to Execution Window
                'You should output to your WorkSheet instead
                Exit For
            End If
        Next j
        
        HTMLdoc.Close
    Next i
    
End Sub

And final note: to see the ouput of Debug.Print, use the Execution Window in VBA

回复收藏 0 原文

~没有更多了~