Board logo

標題: [發問] 請問如何捉取網頁內全部圖片的網止 [打印本頁]
作者: wufonna    時間: 2013-9-10 14:41     標題: 請問如何捉取網頁內全部圖片的網止

請問如何捉取網頁內全部圖片的網指


例如
http://blog.mjjq.com/archives/1975.html

的


.
.
.
.


謝謝
作者: jakcy1234    時間: 2013-9-10 15:04

本帖最後由 jakcy1234 於 2013-9-10 15:05 編輯

回復 1# wufonna

[attach]16004[/attach]
Download NetTransport
right click copy URL to Clipbroad

h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-24.jpg
ht tp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-11.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-05.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-07.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-08.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-09.jpg
ht tp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-10.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-23.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-14.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-01.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-02.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-06.jpg
h ttp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-16.jpg
ht tp://tw.mjjq.com/pic/20081029/mb-qingdao-photo-15.jpg
作者: cji3cj6xu6    時間: 2013-9-10 15:06

現學現賣，你可以利用chrome 然後選一張圖按下右鍵選擇檢查元素，<br>
然後選取resources的 image 就出現一堆圖檔，再來你就應該知道了∼<br>
作者: wufonna    時間: 2013-9-10 16:46

jakcy1234  cji3cj6xu6  大大，謝謝您們
我是想用
CreateObject("InternetExplorer.Application")
是如何用
以後要用在程式中
例如 取得
http://xxx.xxx.xxx/........../a.xls
http://xxx.xxx.xxx/..../.../.....o.zip
各種檔案等
謝謝
作者: GBKEE    時間: 2013-9-10 17:00

回復 3# cji3cj6xu6
  1. Option Explicit
  2. Sub 下載網路照片()
  3.     Dim a As Variant, e As Integer, i As Integer, s As Variant, p As Integer
  4.     With CreateObject("Microsoft.XMLHTTP")
  5.         .Open "get", "http://blog.mjjq.com/archives/1975.html", False
  6.        .send
  7.        a = Split(.responseText, vbLf)
  8.     End With
  9.     With ActiveSheet
  10.         .Pictures.Delete
  11.         .Cells.Clear
  12.         i = 1
  13.         For e = 0 To UBound(a)
  14.             If InStr(a(e), "src=""http://") And InStr(a(e), ".jpg"" /><br />") Then
  15.                 s = Split(a(e), "alt=""")(1)
  16.                 s = Split(s, """ width=""")(0)
  17.                 .Cells(i, 1) = s
  18.                 s = Split(a(e), "src=""")(1)
  19.                 s = Split(s, """ /><br />")(0)
  20.                 .Cells(i, 2) = s
  21.                 p = .Pictures.Count
  22.                 .Cells(1 + (p * 20), "H").Select
  23.                 .Pictures.Insert (.Cells(i, 2))
  24.                 i = i + 1
  25.             End If
  26.        Next
  27.     End With
  28. End Sub
複製代碼
作者: wufonna    時間: 2013-9-10 17:28

謝謝 G大
不知 CreateObject("Microsoft.XMLHTTP") 可以
G大您好
是不是我的系統的問題，執行時有以下的錯誤，請G大指點
謝謝
作者: GBKEE    時間: 2013-9-10 17:58

回復 6# wufonna
不了解這錯誤.(2003 正常)
作者: wufonna    時間: 2013-9-10 19:21

請問G大，是不是
.Pictures.Insert (.Cells(i, 2))
的問題
我註解了，就可執行
謝謝

Option Explicit
Sub 下載網路照片()
    Dim a As Variant, e As Integer, i As Integer, s As Variant, p As Integer
    With CreateObject("Microsoft.XMLHTTP")
        .Open "get", "http://blog.mjjq.com/archives/1975.html", False
       .send
       a = Split(.responseText, vbLf)
    End With
    With ActiveSheet
        .Pictures.Delete
        .Cells.Clear
        i = 1
        For e = 0 To UBound(a)
            If InStr(a(e), "src=""http://") And InStr(a(e), ".jpg"" /><br />") Then
                s = Split(a(e), "alt=""")(1)
                s = Split(s, """ width=""")(0)
                .Cells(i, 1) = s
                s = Split(a(e), "src=""")(1)
                s = Split(s, """ /><br />")(0)
                .Cells(i, 2) = s
                p = .Pictures.Count
                .Cells(1 + (p * 20), "H").Select
              '  .Pictures.Insert (.Cells(i, 2))
                i = i + 1
            End If
       Next
    End With
End Sub
作者: wufonna    時間: 2013-9-10 19:24

請問G大是不是圖檔太大
我的電腦不能跑
作者: stillfish00    時間: 2013-9-10 20:00

回復 6# wufonna
回復 7# GBKEE

我用2010，要把23行改成  .Pictures.Insert .Cells(i, 2).Value 才能跑。
作者: wufonna    時間: 2013-9-10 20:10

謝謝
G大
stillfish00 大
我的也是2010改了就能RUN
是不是2010版的蟲
謝謝 ^0^
作者: GBKEE    時間: 2013-9-11 07:30

回復 11# wufonna
2003接受將 .Pictures.Insert (.Cells(i, 2)) 轉成.Cells(i, 2).Value
10# stillfish00 我用2010，要把23行改成  .Pictures.Insert .Cells(i, 2).Value 才能跑
作者: cji3cj6xu6    時間: 2013-9-11 09:21

真是神了，原來 VBA可以做這麼多事，
真是!$@#%@#$#%@#%#$%^
作者: wufonna    時間: 2013-9-12 13:15

本帖最後由 wufonna 於 2013-9-12 13:16 編輯

請問如宣告字串
<meta name="description" content="提供最方便的網站搜尋、即時新聞、生活資訊和Yahoo奇摩服務入口。">

===========================
Sub TEST()

Dim s As String
s = "<meta name="description" content="提供最方便的網站搜尋、即時新聞、生活資訊和Yahoo奇摩服務入口。">"
End Sub
錯誤
謝謝
作者: GBKEE    時間: 2013-9-12 13:53

回復 14# wufonna
  1. Option Explicit
  2. Sub Ex()
  3.     Dim s As String
  4.     s = """"
  5.     MsgBox s
  6.     s = "A &   ""   &   B"
  7.     MsgBox s
  8.     s = "<meta name=""description"" content=""提供最方便的網站搜尋、即時新聞、生活資訊和Yahoo奇摩服務入口。"">"""
  9.     MsgBox s
  10. End Sub
複製代碼
作者: wufonna    時間: 2013-9-12 14:32

請問G大
split 後面的(1)是刪字元前的全部
(0)刪字元後的全部嗎
謝謝

Sub Ex()
    Dim s As String, i, ss As String
    s = """"
    MsgBox s
    s = "A &   ""   &   B"
    MsgBox s
    s = "<meta name=""description"" content=""提供最方便的網站搜尋、即時新聞、生活資訊和Yahoo奇摩服務入口。"">"
    MsgBox s
    s = Split(s, "content=""")(1)
    MsgBox s
    s = Split(s, """>")(0)
    MsgBox s
End Sub
作者: GBKEE    時間: 2013-9-12 15:03

回復 16# wufonna
請詳看Split 函數vba說明
  1. Split 函數
  2. 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
複製代碼
  1. Option Explicit
  2. Sub Ex()
  3.     Dim s As Variant, i As Integer
  4.     s = "<meta name=""description"" content=""提供最方便的網站搜尋content=""即時新聞content=""、生活資訊和Yahoo奇摩服務入口。"">"
  5.     s = Split(s, "content=""")
  6.     MsgBox Join(s, vbLf)
  7.     MsgBox UBound(s)           '陣列上限元素索引值
  8.     For i = 0 To UBound(s)
  9.         MsgBox s(i)
  10.     Next
  11. End Sub
複製代碼
作者: wufonna    時間: 2013-9-12 15:51

非常謝謝 G 大 ^_^
學生很多問題 /___\
網頁內很多樣式的標籤
可用這樣的方法，還是有什麼方便的方法
Sub test()
Dim a, b, c, d

a = "<img src=""http://l.yimg.com/ud/hp_editor/tw/13/09/12/15/130asf302-190c8a5.jpg"" alt=""Video 圖片"" width=160 height=115><br>"
b = "<img src=""http://l.yimg.com/ud/hp_editor/tw/13/09/12/15/asf912151302190c8a35.jpg"" ></p>"
c = "<img src=""http://l.yimg.com/ud/hp_editor/tw/13/09/12/15/130f302-19c8a35.jpg"" alt=""Video 圖片"" height=115><br />"
d = "<img width=160 height=115 src=http://l.yimg.com/ud/hp_editor/tw/13/09/12/15/13092151302190c8a35.jpg  ></a>"
a = Split(a, "http://")(1)
a = Split(a, ".jpg")(0)
a = "http://" & a & ".jpg"
b = Split(b, "http://")(1)
b = Split(b, ".jpg")(0)
b = "http://" & b & ".jpg"
c = Split(c, "http://")(1)
c = Split(c, ".jpg")(0)
c = "http://" & c & ".jpg"
d = Split(d, "http://")(1)
d = Split(d, ".jpg")(0)
d = "http://" & d & ".jpg"
MsgBox a & Chr(10) & b & Chr(10) & c & Chr(10) & d

End Sub
謝謝
作者: GBKEE    時間: 2013-9-12 16:17

回復 18# wufonna
  1. Option Explicit
  2. Sub test()
  3.     Dim a As String, b As String, c As String, d As String
  4.     Dim AR As Variant, i As Integer, S(1 To 2) As Integer
  5.     a = "<img src=""http://l.yimg.com/ud/hp_editor/tw/13/09/12/15/130asf302-190c8a5.jpg"" alt=""Video 圖片"" width=160 height=115><br>"
  6.     b = "<img src=""http://l.yimg.com/ud/hp_editor/tw/13/09/12/15/asf912151302190c8a35.jpg"" ></p>"
  7.     c = "<img src=""http://l.yimg.com/ud/hp_editor/tw/13/09/12/15/130f302-19c8a35.jpg"" alt=""Video 圖片"" height=115><br />"
  8.     d = "<img width=160 height=115 src=http://l.yimg.com/ud/hp_editor/tw/13/09/12/15/13092151302190c8a35.jpg  ></a>"
  9.     AR = Array(a, b, c, d)
  10.     For i = 0 To UBound(AR)
  11.         S(1) = InStr(AR(i), "http://")
  12.         S(2) = InStr(AR(i), "jpg") + 3
  13.         AR(i) = Mid(AR(i), S(1), S(2) - S(1))
  14.     Next
  15.     MsgBox Join(AR, vbLf)
  16. End Sub
複製代碼
作者: wufonna    時間: 2013-9-12 16:30

謝謝  G 大
excel 內的好多函數就學不完，^_^
要多多的練習，
非常感謝 G 大



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)