返回列表 上一主題 發帖

請問如何將網頁的圖片存檔

請問如何將網頁的圖片存檔

With CreateObject("InternetExplorer.application")           
        .Visible = True                                       
        .Navigate "http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/brokerBS.php?l=zh-tw"
      
        Do Until .ReadyState = 4               
            DoEvents
        Loop
Set img = .document.all.tags("img")(0)
end with
請問我如何把img這個圖存成c:\2.png

回復 1# flask
最近股票公開網頁資訊的下載,都有驗證碼防止自動下載.
由於驗證碼不好破解,可試試半自動下載
1請在工作表上插入一圖片(命名:驗證圖)
2圖片巨集指定為 ,Sheet1.圖形更新,這程式

為使VBA入門者,有實作經驗,故僅附上程式碼.



ThisWorkbook模組的程式碼
  1. Option Explicit
  2. Private Sub Workbook_Open()
  3.     Sheet1.Msg = True
  4.     Run "Sheet1.圖形更新"
  5. End Sub
  6. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  7.     On Error Resume Next
  8.     If Not Sheet1.IE Is Nothing Then Sheet1.IE.Quit
  9. End Sub
複製代碼
Sheet1模組的程式碼
  1. Option Explicit
  2. Public IE As Object, Msg As Boolean
  3. Const 圖形 = "d:\驗證圖.jpg"
  4. Const 證券代號 = "F2"
  5. Const 驗證碼 = "F4"
  6. Private Sub Worksheet_Change(ByVal Target As Range)
  7.     Range(證券代號).Interior.ColorIndex = IIf(Range(證券代號).Value = "", 2, 36)
  8.     With Target.Cells(1)
  9.          If .Address(0, 0) = 驗證碼 Then .Interior.ColorIndex = IIf(Len(Trim(.Cells)) = 5, 36, 2)
  10.          If .Address(0, 0) = 驗證碼 And Len(Trim(.Cells)) = 5 And Range(證券代號).Value <> "" Then
  11.             If IE Is Nothing Then
  12.                 Target = ""
  13.                 Msg = True
  14.                 圖形更新
  15.                 Exit Sub
  16.             End If
  17.             Application.EnableEvents = False
  18.             日報表載入
  19.             Target = ""
  20.             Application.EnableEvents = True
  21.         End If
  22.     End With
  23. End Sub
  24. Private Sub 日報表載入()
  25.     Dim e As Object, a As Object, K  As Integer, i As Integer, ii As Integer, s As String
  26.     If IE Is Nothing Then
  27.         圖形更新
  28.         MsgBox "驗證圖已更新"
  29.         Exit Sub
  30.     End If
  31.     With IE
  32.         .Document.ALL.tags("INPUT")("stk_code").Value = Range(證券代號)
  33.         .Document.ALL.tags("INPUT")("auth_num").Value = Trim(Range(驗證碼))
  34.         Set a = .Document.ALL.tags("BUTTON")
  35.         For Each e In a
  36.             If Trim(e.innertext) = "查詢" And e.ID = "" Then
  37.             e.Click
  38.             Exit For
  39.             End If
  40.         Next
  41.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  42.         K = 6
  43.         UsedRange.Offset(6).Clear
  44.         If .Document.body.innertext Like "***該股票該日無交易資訊***" Then s = "***該股票該日無交易資訊***"
  45.         If .Document.body.innertext Like "***驗證碼錯誤,請重新查詢。***" Then s = "***驗證碼錯誤,請重新查詢。*** "
  46.         If s <> "" Then
  47.             Range("a" & K + 1) = s
  48.             MsgBox s
  49.             GoTo NN
  50.         End If
  51.         Set a = .Document.ALL.tags("table")(0)
  52.         For i = 0 To a.Rows.Length - 1
  53.             K = K + 1
  54.             For ii = 0 To a.Rows(i).Cells.Length - 1
  55.                 Cells(K, ii + 1) = a.Rows(i).Cells(ii).innertext
  56.             Next
  57.         Next
  58.         Set a = .Document.ALL.tags("table")(2)
  59.         K = K + 1
  60.         For i = 0 To a.Rows.Length - 1
  61.             K = K + 1
  62.             For ii = 0 To a.Rows(i).Cells.Length - 1
  63.                 Cells(K, ii + 1) = a.Rows(i).Cells(ii).innertext
  64.             Next
  65.         Next
  66.         Set a = .Document.ALL.tags("table")(3)
  67.         For i = 1 To a.Rows.Length - 1
  68.             K = K + 1
  69.             For ii = 0 To a.Rows(i).Cells.Length - 1
  70.                 Cells(K, ii + 1) = a.Rows(i).Cells(ii).innertext
  71.             Next
  72.         Next
  73.         MsgBox Range("d7") & " 日報表載入 完畢!!"
  74. NN:
  75.         .Quit
  76.     End With
  77.     Set IE = Nothing
  78.     圖形更新
  79. End Sub
  80. Private Sub Get_Ie()
  81.     Set IE = CreateObject("InternetExplorer.Application")
  82.     With IE
  83.        ' .Visible = True
  84.         '券商買賣證券日報表查詢系統(一般交易)
  85.         .Navigate "http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/brokerBS.php?l=zh-tw"
  86.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  87.     End With
  88. End Sub
  89. Private Sub 圖形更新()
  90.     If IE Is Nothing Then Get_Ie
  91.     If Msg Then MsgBox "驗證圖 更新完畢"
  92.     Msg = False
  93.     With IE
  94.         .Refresh
  95.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  96.         網路圖片存檔 .Document.ALL.tags("IMG")(0).href
  97.     End With
  98.     Sheet1.Shapes("驗證圖").Fill.UserPicture 圖形    '
  99. End Sub
  100. Private Sub 網路圖片存檔(img As String)
  101.     Dim xml As Object     '用來取得網頁資料
  102.     Dim stream            'As ADODB.stream   '用來儲存二進位檔案
  103.     Set xml = CreateObject("Microsoft.XMLHTTP")
  104.     Set stream = CreateObject("ADODB.stream")
  105.     xml.Open "GET", img, 0
  106.     xml.send
  107.     With stream
  108.         .Open
  109.         .Type = 1
  110.         .write xml.ResponseBody
  111.         If Dir(圖形) <> "" Then Kill 圖形
  112.         .SaveToFile (圖形)
  113.         .Close
  114.     End With
  115. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

感謝GBKEE大大的回答!
Private Sub 網路圖片存檔(img As String)
    Dim xml As Object     '用來取得網頁資料
    Dim stream            'As ADODB.stream   '用來儲存二進位檔案
    Set xml = CreateObject("Microsoft.XMLHTTP")
    Set stream = CreateObject("ADODB.stream")
    xml.Open "GET", img, 0
    xml.send
    With stream
        .Open
        .Type = 1
        .write xml.ResponseBody
        If Dir(圖形) <> "" Then Kill 圖形
        .SaveToFile (圖形)
        .Close
    End With
End Sub
以這方式下載的圖片與IE頁面的圖不是相同的圖
要如何下載回來的是IE頁面的圖,因為它是PNG檔
我試了幾種方式都沒辦法是IE頁面的圖,驗證碼的
圖要轉成BMP格式才能做2值化的處理.如果不是PNG
檔的話用GetClipboardData就可以處理了!一直想
破頭個人的功力實在太淺了還在學習中!希望老師
能提點一下!

TOP

測試完發現驗證碼輸入頁面上的碼與存檔圖上的碼都是OK的??

TOP

下載的圖片與IE頁面的圖不是相同的圖
導入都會"驗證碼已逾期,請重新查詢"
失敗!如何抓下來圖是ie頁面顯示的圖片咧?

TOP

回復 5# flask
程式執行如圖



   
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

原來是驗證碼tessdata-OCR視別錯誤!

TOP

回復 6# GBKEE
請問 版大這是那裡出錯
謝謝

2014-12-13_114055.jpg (98.46 KB)

2014-12-13_114055.jpg

活頁簿1.rar (15.6 KB)

TOP

本帖最後由 GBKEE 於 2014-12-13 13:24 編輯

回復 8# wufonna
這錯誤是你將 IE關閉了
VBA按下重設,重新執行程式
  1. Private Sub Get_Ie()
  2.     Set IE = CreateObject("InternetExplorer.Application")
  3.     With IE
  4.        ' .Visible = True  *** 不顯示就是防止使用者關閉IE
  5.         '券商買賣證券日報表查詢系統(一般交易)
  6.         .Navigate "http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/brokerBS.php?l=zh-tw"
  7.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  8.     End With
  9. End Sub
複製代碼


插入的圖片需使用繪圖的圖片
  1. 工作表1.Shapes("驗證圖").Fill.UserPicture 圖形
複製代碼
附檔插入的圖片沒改名稱 驗證圖
也可以使用 Shapes(索引值)->如Shapes(1)
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 9# GBKEE

GBKEE 大
執行有開啟IE
錯諤碼如下,還是我有那一步做了,謝謝

檔安同放D:\ 根目下

2014-12-13_143120.jpg (111.53 KB)

2014-12-13_143120.jpg

2014-12-13_143151.jpg (36.57 KB)

2014-12-13_143151.jpg

活頁簿1.rar (23.84 KB)

TOP

        靜思自在 : 脾氣嘴巴不好,心地再好也不能算是好人。
返回列表 上一主題