1234
返回列表 上一主題 發帖

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

HSIEN6001

帖子
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的方式 , 收下囉!謝謝~

TOP

HSIEN6001

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

論壇榮譽勳章論壇贊助勳章
32#
發表於 2014-12-17 17:50 | 只看該作者
回復 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
複製代碼

TOP

GBKEE

帖子
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
  1.     '***** 判斷讀取資料  End *************************************************************
  2.             End If  '沒有With 少這 End If
複製代碼
但這程式尚有缺失需修改.

  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   

  11.        沒有dir檢查 存檔之檔案是否存在
  12.          .SaveToFile (path & 代號 & ".csv")
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

HSIEN6001

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

論壇榮譽勳章論壇贊助勳章
34#
發表於 2014-12-18 08:44 | 只看該作者
回復 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 *************************************************************
複製代碼

TOP

GBKEE

帖子
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
  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 下一個
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

HSIEN6001

帖子
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

TOP

kenkid

帖子
4 
主題
0 
精華
0 
積分
6 
點名
0  
作業系統
WIN7 
軟體版本
SP2 
閱讀權限
10 
註冊時間
2014-12-28 
最後登錄
2015-5-18 
37#
發表於 2014-12-28 15:48 | 只看該作者
太強了...我正好想破頭了T_T...沒想到有大大分享解決辦法^^

TOP

        靜思自在 : 不怕事多，只怕多事。
1234
返回列表 上一主題