請問如何將網頁的圖片存檔 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 請問如何將網頁的圖片存檔

返回列表下一主題上一主題發帖

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

中學生 Rank: 2

帖子: 219
主題: 24
精華: 0
積分: 243
點名: 0
作業系統: Windows10
軟體版本: Office2016
閱讀權限: 20
性別: 女
註冊時間: 2012-4-18
最後登錄: 2022-2-7

論壇榮譽勳章論壇贊助勳章

31^# 跳轉到 »

發表於 2014-12-17 01:13 | 只看該作者

回復 29# GBKEE

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

中學生 Rank: 2

帖子: 219
主題: 24
精華: 0
積分: 243
點名: 0
作業系統: Windows10
軟體版本: Office2016
閱讀權限: 20
性別: 女
註冊時間: 2012-4-18
最後登錄: 2022-2-7

論壇榮譽勳章論壇贊助勳章

32^#

發表於 2014-12-17 17:50 | 只看該作者

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

Sub 下載CSV()
Dim path As String, 日期 As String, URL As String, 代號
path = "C:\myStock\"
日期 = Format(Date, "emmdd")
Dim Rng As Range
AA:
Set Rng = [C:C].Find("NG", , , xlWhole)
Sheets("下載依據").Activate
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
驗證碼 = InputBox("輸入查詢驗證碼", "驗證碼", code) '驗證碼 = InputBox
For Each 代號 In Range(Rng.Offset(0, -2), [E65536].End(xlUp))
.document.all("stk_code").Value = 代號
.document.all("auth_num").Value = 驗證碼
'**** 直接下載CSV ****
Dim xml As Object
Dim stream
Set xml = CreateObject("Microsoft.XMLHTTP")
Set stream = CreateObject("ADODB.stream")
'GET http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/download_ALLCSV.php?curstk=8069&stk_date=1031215&auth=驗證碼
URL = "http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/download_ALLCSV.php?curstk=" & 代號 & "&stk_date=" & 日期 & "&auth=" & 驗證碼
xml.Open "GET", URL, 0
xml.send
With stream
.Type = 1
.Open
.write xml.responseBody
'**** 判斷讀取資料 ****************************************************************
If .document.body.Innertext Like "*該日無交易資訊*" Then
GoTo NN 'Goto 下一個
ElseIf .document.body.Innertext Like "*驗證碼錯誤，請重新查詢*" Then
Sheets("下載依據").Range("C:C").Delete '清除舊的NG記號
代號.Offset(, 2) = "NG" '新增斷點
.Quit '關閉 IE 視窗
GoTo AA
ElseIf .document.body.Innertext Like "*驗證碼已逾期，請重新查詢*" Then
Sheets("下載依據").Range("C:C").Delete '清除舊的NG記號
代號.Offset(, 2) = "NG" '新增斷點
.Quit '關閉 IE 視窗
GoTo AA
'***** 判斷讀取資料 End *************************************************************
.SaveToFile (path & 代號 & ".csv")
.Close
End With
NN:
Next
.Quit '關閉 IE 視窗
End With
Range("C2") = "NG" '重新作記號,方便下回下載
End Sub

複製代碼

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

33^#

發表於 2014-12-18 05:45 | 只看該作者

回復 32# HSIEN6001

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

複製代碼

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

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

複製代碼

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

中學生 Rank: 2

帖子: 219
主題: 24
精華: 0
積分: 243
點名: 0
作業系統: Windows10
軟體版本: Office2016
閱讀權限: 20
性別: 女
註冊時間: 2012-4-18
最後登錄: 2022-2-7

論壇榮譽勳章論壇贊助勳章

34^#

發表於 2014-12-18 08:44 | 只看該作者

回復 33# GBKEE

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

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

複製代碼

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

35^#

發表於 2014-12-18 12:33 | 只看該作者

回復 34# HSIEN6001

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

複製代碼

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

中學生 Rank: 2

帖子: 219
主題: 24
精華: 0
積分: 243
點名: 0
作業系統: Windows10
軟體版本: Office2016
閱讀權限: 20
性別: 女
註冊時間: 2012-4-18
最後登錄: 2022-2-7

論壇榮譽勳章論壇贊助勳章

36^#

發表於 2014-12-18 14:53 | 只看該作者

回復 35# GBKEE

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

小學生 Rank: 1

帖子: 4
主題: 0
精華: 0
積分: 6
點名: 0
作業系統: WIN7
軟體版本: SP2
閱讀權限: 10
註冊時間: 2014-12-28
最後登錄: 2015-5-18

37^#

發表於 2014-12-28 15:48 | 只看該作者

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

靜思自在 : 信心、毅力、勇氣三者具備，則天下沒有做不成的事。

返回列表下一主題上一主題