HSIEN6001

回復 29# GBKEE

版大 Workbook open 匯入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

複製代碼

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

回復 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

回復 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

回復 35# GBKEE


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

kenkid

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