[發問] 圖片的網頁,有辦法用程式下載嗎?或是可以轉為文字?

PKKO

網址如下:
https://www.iyp.com.tw/search.php?a_id=5&k=%E9%A4%90%E5%BB%B3
主要難度在於,電話+地址都是圖片
Q1:有辦法抓到文字的電話或是地址嗎?
Q2:抓不到文字,可以抓圖片嗎?

小弟的需求是抓公司名稱、說明、地址、電話
又麻煩各位大大了!

GBKEE

回復 1# PKKO

試試看

1. Option Explicit
   
2. Const Img = "d:\Tel.jpg"
   
3. Sub Ex_()
   
4.     Dim i As Integer, E As Object, a, St As String, x As Integer, Sh As Worksheet
   
5.     St = "search/"
   
6.     Set Sh = ActiveSheet
   
7.     With Sh
   
8.         .Cells.Clear
   
9.         .Pictures.Delete
   
10.         .Columns("A:A").ColumnWidth = 29.25
    
11.         .Columns("B:B").ColumnWidth = 33.13
    
12.         .Columns("C:C").ColumnWidth = 28.5
    
13.         .Cells.RowHeight = 19.5
    
14.     End With
    
15.     With CreateObject("InternetExplorer.Application")
    
16.         .Visible = True
    
17.         .Navigate "https://www.iyp.com.tw/search.php?a_id=5&k=%E9%A4%90%E5%BB%B3"
    
18.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
19.         With .Document
    
20.             For Each a In .getElementByID("search-res").all.TAGS("LI")
    
21.                 If a.ID <> "" Then
    
22.                     i = i + 1
    
23.                     With a
    
24.                         Sh.Cells(i, "a") = .all.TAGS("A")(0).INNERTEXT
    
25.                         Sh.Cells(i, "d") = .all.TAGS("A")(0).href
    
26.                         Set E = .all.TAGS("SPAN")(2)
    
27.                         With Sh.Cells(i, "B")
    
28.                             .Cells = Split(E.outerHTML, """>")(0)
    
29.                             x = InStr(.Cells, St)
    
30.                             .Cells = Mid(.Cells, x + Len(St))
    
31.                         End With
    
32.                         下載網路圖片 .all.TAGS("IMG")(0).href
    
33.                         With Sh.Cells(i, "C")
    
34.                             .Select
    
35.                             Set E = Sh.Pictures.Insert(Img)
    
36.                             E.Height = .Cells.Height                      '照片的右方在工作表上的位置
    
37.                             E.Width = .Cells.Width
    
38.                         End With
    
39.                     End With
    
40.                 End If
    
41.             Next
    
42.         End With
    
43.         .Quit        '關閉網頁
    
44.     End With
    
45.     If Dir(Img) <> "" Then Kill Img
    
46. End Sub
    
47. Private Sub 下載網路圖片(Url As String)
    
48.     Dim xml As Object     '用來取得網頁資料
    
49.     Dim stream                  'As ADODB.stream   '用來儲存二進位檔案
    
50.     Set xml = CreateObject("Microsoft.XMLHTTP")
    
51.     Set stream = CreateObject("ADODB.stream")
    
52.     xml.Open "GET", Url, 0
    
53.     xml.send
    
54.     With stream
    
55.         .Open
    
56.         .Type = 1
    
57.         .write xml.ResponseBody
    
58.         If Dir(Img) <> "" Then Kill Img
    
59.         .SaveToFile (Img)
    
60.         .Close
    
61.     End With
    
62. End Sub

複製代碼

PKKO

回復 2# GBKEE


    感謝超版大大...實在太厲害...小弟許多程式碼都是與您學習
目前執行第一筆成功
第二筆則是卡在Img的地方,她顯示的硬碟位置為D曹,而小弟電腦只有單一C曹

稍晚研究一下,感謝大大!

GBKEE

回復 3# PKKO

要活用,這裡改一下

1. Const Img = "C:\Tel.jpg"

複製代碼

PKKO

回復 4# GBKEE


    感謝超版大大,沒注意到原來在最上面
剩下的小弟就來拜讀一下程式碼了,謝謝您!