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

flask

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

kenkid

太強了...我正好想破頭了T_T...沒想到有大大分享解決辦法^^

HSIEN6001

回復 35# GBKEE


如果用 .responseText
怎麼寫,達到 IF ...Then...ElseIF.... EndIf

GBKEE

回復 34# HSIEN6001

1.   With stream   '在這With下
   
2.                .Type = 1
   
3.                 .Open
   
4.                 .write xml.responseBody
   
5.                 '**** 判斷讀取資料   ****************************************************************
   
6.                 If .document.body.Innertext Like "*該日無交易資訊*" Then
   
7.                  '*******  .document 是IE的子物件******
   
8.                     GoTo NN  'Goto 下一個

複製代碼

HSIEN6001

回復 33# GBKEE


    出現執行階段錯誤'438 , 物件不支援此屬性或方法
跟這一段判斷式有關,不知道該怎麼改 ?
沒判斷內容,會下載到空值

1.                 .write xml.responseBody
   
2.                 '**** 判斷讀取資料   ****************************************************************
   
3.                 If .document.body.Innertext Like "*該日無交易資訊*" Then
   
4.                     GoTo NN  'Goto 下一個
   
5.                 ElseIf .document.body.Innertext Like "*驗證碼錯誤，請重新查詢*" Then
   
6.                      '代號.Offset(, 2) = "NG"
   
7.                      GoTo AA ''視窗不關閉 & 重新輸入驗證碼 & 代號
   
8.                 ElseIf .document.body.Innertext Like "*驗證碼已逾期，請重新查詢*" Then
   
9.                     Sheets("下載依據").Range("F:F").Delete      '清除舊的NG記號
   
10.                     代號.Offset(, 1) = "NG"                     '在隔壁 第1欄位標註 "NG" , 方便重新抓取時,避開已經下載的資料
    
11.                     .Quit   '關閉 IE 視窗
    
12.                      GoTo AA ''視窗重新開啟 & 重新輸入驗證碼 & 代號
    
13.                 End If
    
14.                 '***** 判斷讀取資料  End *************************************************************

複製代碼

GBKEE

回復 32# HSIEN6001

1.     '***** 判斷讀取資料  End *************************************************************
   
2.             End If  '沒有With 少這 End If

複製代碼

但這程式尚有缺失需修改.

1. 
   
2. Set Rng = [C:C].Find("NG", , , xlWhole)  '找不時的處置???
   
3. For Each 代號 In Range(Rng.Offset(0, -2), [E65536].End(xlUp)) '須在前面
   
4.         With CreateObject("InternetExplorer.application") '在For Each 代號 迴圈內
   
5.          
   
6.          '少掉查詢按鍵
   
7.          if ....
   
8.          '這段 IF 判斷要放在
   
9.        End If   
   
10. 
    
11.        沒有dir檢查 存檔之檔案是否存在
    
12.          .SaveToFile (path & 代號 & ".csv")

複製代碼

HSIEN6001

回復 29# GBKEE
您好,這裡一直出現缺 With 不知道哪裡要修改
麻煩幫忙校正問題

1. Sub 下載CSV()
   
2. Dim path As String, 日期 As String, URL As String, 代號
   
3. path = "C:\myStock\"
   
4. 日期 = Format(Date, "emmdd")
   
5. Dim Rng As Range
   
6. AA:
   
7.     Set Rng = [C:C].Find("NG", , , xlWhole)
   
8.     Sheets("下載依據").Activate
   
9.     With CreateObject("InternetExplorer.application")
   
10.         .Visible = True
    
11.         .navigate "http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/brokerBS.php?l=zh-tw"
    
12.             Do Until .readyState = 4
    
13.                 DoEvents
    
14.             Loop
    
15.         驗證碼 = InputBox("輸入查詢驗證碼", "驗證碼", code)   '驗證碼 = InputBox
    
16.         For Each 代號 In Range(Rng.Offset(0, -2), [E65536].End(xlUp))
    
17.             .document.all("stk_code").Value = 代號
    
18.             .document.all("auth_num").Value = 驗證碼
    
19.         '**** 直接下載CSV ****
    
20.         Dim xml As Object
    
21.         Dim stream
    
22.         Set xml = CreateObject("Microsoft.XMLHTTP")
    
23.         Set stream = CreateObject("ADODB.stream")
    
24.             'GET http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/download_ALLCSV.php?curstk=8069&stk_date=1031215&auth=驗證碼
    
25.             URL = "http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/download_ALLCSV.php?curstk=" & 代號 & "&stk_date=" & 日期 & "&auth=" & 驗證碼
    
26.                 xml.Open "GET", URL, 0
    
27.                 xml.send
    
28.             With stream
    
29.                 .Type = 1
    
30.                 .Open
    
31.                 .write xml.responseBody
    
32.                 '**** 判斷讀取資料   ****************************************************************
    
33.                 If .document.body.Innertext Like "*該日無交易資訊*" Then
    
34.                     GoTo NN  'Goto 下一個
    
35.                 ElseIf .document.body.Innertext Like "*驗證碼錯誤，請重新查詢*" Then
    
36.                     Sheets("下載依據").Range("C:C").Delete      '清除舊的NG記號
    
37.                     代號.Offset(, 2) = "NG"                     '新增斷點
    
38.                     .Quit   '關閉 IE 視窗
    
39.                     GoTo AA
    
40.                  ElseIf .document.body.Innertext Like "*驗證碼已逾期，請重新查詢*" Then
    
41.                     Sheets("下載依據").Range("C:C").Delete      '清除舊的NG記號
    
42.                     代號.Offset(, 2) = "NG"                     '新增斷點
    
43.                     .Quit   '關閉 IE 視窗
    
44.                     GoTo AA
    
45.                 '***** 判斷讀取資料  End *************************************************************
    
46.                 .SaveToFile (path & 代號 & ".csv")
    
47.                 .Close
    
48.             End With
    
49. NN:
    
50.     Next
    
51.         .Quit   '關閉 IE 視窗
    
52.     End With
    
53.     Range("C2") = "NG"  '重新作記號,方便下回下載
    
54. End Sub

複製代碼

HSIEN6001

回復 29# GBKEE

版大 Workbook open 匯入CSV的方式 , 收下囉!謝謝~

HSIEN6001

回復 25# flask

我已經看懂了,太厲害了
真的很快!!謝謝

GBKEE

回復 28# HSIEN6001
還有 Workbooks.Open 可用

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.           CSV載入
    
20.             Target = ""
    
21.             Application.EnableEvents = True
    
22.         End If
    
23.     End With
    
24. End Sub
    
25. 
    
26. Private Sub Get_Ie()
    
27.     Set IE = CreateObject("InternetExplorer.Application")
    
28.     With IE
    
29.         .Visible = True
    
30.         '券商買賣證券日報表查詢系統（一般交易）
    
31.         .Navigate "http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/brokerBS.php?l=zh-tw"
    
32.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
33.     End With
    
34. End Sub
    
35. 
    
36. Private Sub 圖形更新()
    
37.     If IE Is Nothing Then Get_Ie
    
38.     If Msg Then MsgBox "驗證圖 更新完畢"
    
39.     Msg = False
    
40.     With IE
    
41.         .Refresh
    
42.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
43.         網路圖片存檔 .Document.all.tags("IMG")(0).href
    
44.     End With
    
45.     Sheet1.Shapes("驗證圖").Fill.UserPicture 圖形    '
    
46. End Sub
    
47. 
    
48. Private Sub 網路圖片存檔(img As String)
    
49.     Dim xml As Object     '用來取得網頁資料
    
50.     Dim stream            'As ADODB.stream   '用來儲存二進位檔案
    
51.     Set xml = CreateObject("Microsoft.XMLHTTP")
    
52.     Set stream = CreateObject("ADODB.stream")
    
53.     xml.Open "GET", img, 0
    
54.     xml.send
    
55.     With stream
    
56.         .Open
    
57.         .Type = 1
    
58.         .write xml.responseBody
    
59.         If Dir(圖形) <> "" Then Kill 圖形
    
60.         .SaveToFile (圖形)
    
61.         .Close
    
62.     End With
    
63. End Sub
    
64. 
    
65. Private Sub CSV載入()
    
66.     Dim e As Object, A As Object, kDate As String, S As String
    
67.     Application.EnableEvents = True
    
68.     If IE Is Nothing Then
    
69.         圖形更新
    
70.         MsgBox "驗證圖已更新"
    
71.         Exit Sub
    
72.     End If
    
73.     With IE
    
74.         .Document.all.tags("INPUT")("stk_code").Value = Range(證券代號)
    
75.         .Document.all.tags("INPUT")("auth_num").Value = Trim(Range(驗證碼))
    
76.         Set A = .Document.all.tags("BUTTON")
    
77.         For Each e In A
    
78.             If Trim(e.Innertext) = "查詢" And e.ID = "" Then
    
79.             e.Click
    
80.             Exit For
    
81.             End If
    
82.         Next
    
83.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
84.         If .Document.body.Innertext Like "***該股票該日無交易資訊***" Then S = "***該股票該日無交易資訊***"
    
85.         If .Document.body.Innertext Like "***驗證碼錯誤，請重新查詢。***" Then S = "***驗證碼錯誤，請重新查詢。*** "
    
86.         If S <> "" Then
    
87.             'Range("a" & k + 1) = S
    
88.             MsgBox S
    
89.             GoTo NN
    
90.         End If
    
91.         kDate = Format(Date, "emmdd")
    
92.         Application.DisplayAlerts = False
    
93.         With Workbooks.Open("http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/download_ALLCSV.php?curstk=" & Range(證券代號) & "&stk_date=" & kDate & "&&auth=" & Range(驗證碼))
    
94.             .SaveAs "D:\" & Range(證券代號)
    
95.             With .Sheets(1)
    
96.                 .UsedRange.Range("G:K").SpecialCells(xlCellTypeConstants).Offset(1).Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
    
97.                 .UsedRange.Range("G:K").Clear
    
98.             End With
    
99.             .Close True
    
100.         End With
     
101.         Application.DisplayAlerts = True
     
102.         MsgBox "證券代號 : " & Range(證券代號) & " CSV 載入完畢"
     
103. NN:
     
104.         .Quit
     
105.     End With
     
106.     Set IE = Nothing
     
107.     圖形更新
     
108. End Sub

複製代碼