標題: [發問] 第一次學用VBA抓取資料 遇到一些問題 [打印本頁]

---

作者: s93213241    時間: 2013-12-19 01:18     標題: 第一次學用VBA抓取資料 遇到一些問題

前言: 小弟我有試著用簡單的iqy去撰寫也成功了,但只要匯入4個以上(含),程式就會跑出無法抓取web資料沒辦法只好再來自學vba

以下是我爬了3天的成果  以下程式碼都是用錄製取的 總共有5個動作需要做  前面四個抓出來都是亂碼但是重要的數值都有截取出來,但是他都會在插入行在運算結果 很困擾我

最後一段程式碼想寫出只顯示出當日表單 只要修改紅色日期相對就會帶出那個日期的表單

程式希望可以在a分頁執行 在b分頁帶出結果出來  

以上感謝看完此篇的有緣人 謝謝   假如有其他需要我補充說明的歡迎提出  因為並不能直接開網頁出來看結果

1. Sub 巨集1()
   
2. '
   
3. ' 巨集1 巨集
   
4. '
   
5. 
   
6. '
   
7.     With ActiveSheet.QueryTables.Add(Connection:= _
   
8.         "URL;http://cagweb02.hct.com.tw/pls/cagweb/CAGWEB.C_PCTHA272?pArea=000&pSCd=6006&pDayFlg=0&pDayFlg1=1&pSearchFlg=2&pCustFlg=03897810001" _
   
9.         , Destination:=Range("$A$1"))
   
10.         .Name = _
    
11.         "CAGWEB.C_PCTHA272?pArea=000&pSCd=6006&pDayFlg=0&pDayFlg1=1&pSearchFlg=2&pCustFlg=03897810001"
    
12.         .FieldNames = True
    
13.         .RowNumbers = False
    
14.         .FillAdjacentFormulas = False
    
15.         .PreserveFormatting = True
    
16.         .RefreshOnFileOpen = False
    
17.         .BackgroundQuery = True
    
18.         .RefreshStyle = xlInsertDeleteCells
    
19.         .SavePassword = False
    
20.         .SaveData = True
    
21.         .AdjustColumnWidth = True
    
22.         .RefreshPeriod = 0
    
23.         .WebSelectionType = xlAllTables
    
24.         .WebFormatting = xlWebFormattingNone
    
25.         .WebPreFormattedTextToColumns = True
    
26.         .WebConsecutiveDelimitersAsOne = True
    
27.         .WebSingleBlockTextImport = False
    
28.         .WebDisableDateRecognition = False
    
29.         .WebDisableRedirections = False
    
30.         .Refresh BackgroundQuery:=False
    
31.     End With
    
32.         With ActiveSheet.QueryTables.Add(Connection:= _
    
33.         "URL;http://cagweb02.hct.com.tw/pls/cagweb/CAGWEB.C_PCTHA272?pArea=000&pSCd=6006&pDayFlg=0&pDayFlg1=1&pSearchFlg=2&pCustFlg=04413850008" _
    
34.         , Destination:=Range("$A$7"))
    
35.         .Name = _
    
36.         "CAGWEB.C_PCTHA272?pArea=000&pSCd=6006&pDayFlg=0&pDayFlg1=1&pSearchFlg=2&pCustFlg=04413850008"
    
37.         .FieldNames = True
    
38.         .RowNumbers = False
    
39.         .FillAdjacentFormulas = False
    
40.         .PreserveFormatting = True
    
41.         .RefreshOnFileOpen = False
    
42.         .BackgroundQuery = True
    
43.         .RefreshStyle = xlInsertDeleteCells
    
44.         .SavePassword = False
    
45.         .SaveData = True
    
46.         .AdjustColumnWidth = True
    
47.         .RefreshPeriod = 0
    
48.         .WebSelectionType = xlAllTables
    
49.         .WebFormatting = xlWebFormattingNone
    
50.         .WebPreFormattedTextToColumns = True
    
51.         .WebConsecutiveDelimitersAsOne = True
    
52.         .WebSingleBlockTextImport = False
    
53.         .WebDisableDateRecognition = False
    
54.         .WebDisableRedirections = False
    
55.         .Refresh BackgroundQuery:=False
    
56.     End With
    
57.             With ActiveSheet.QueryTables.Add(Connection:= _
    
58.         "URL;http://cagweb02.hct.com.tw/pls/cagweb/CAGWEB.C_PCTHA272?pArea=000&pSCd=6006&pDayFlg=0&pDayFlg1=1&pSearchFlg=2&pCustFlg=03909690001" _
    
59.         , Destination:=Range("$A$13"))
    
60.         .Name = _
    
61.         "CAGWEB.C_PCTHA272?pArea=000&pSCd=6006&pDayFlg=0&pDayFlg1=1&pSearchFlg=2&pCustFlg=03909690001"
    
62.         .FieldNames = True
    
63.         .RowNumbers = False
    
64.         .FillAdjacentFormulas = False
    
65.         .PreserveFormatting = True
    
66.         .RefreshOnFileOpen = False
    
67.         .BackgroundQuery = True
    
68.         .RefreshStyle = xlInsertDeleteCells
    
69.         .SavePassword = False
    
70.         .SaveData = True
    
71.         .AdjustColumnWidth = True
    
72.         .RefreshPeriod = 0
    
73.         .WebSelectionType = xlAllTables
    
74.         .WebFormatting = xlWebFormattingNone
    
75.         .WebPreFormattedTextToColumns = True
    
76.         .WebConsecutiveDelimitersAsOne = True
    
77.         .WebSingleBlockTextImport = False
    
78.         .WebDisableDateRecognition = False
    
79.         .WebDisableRedirections = False
    
80.         .Refresh BackgroundQuery:=False
    
81.     End With
    
82.              With ActiveSheet.QueryTables.Add(Connection:= _
    
83.         "URL;http://cagweb02.hct.com.tw/pls/cagweb/CAGWEB.C_PCTHA272?pArea=000&pSCd=6006&pDayFlg=0&pDayFlg1=1&pSearchFlg=2&pCustFlg=02074160008" _
    
84.         , Destination:=Range("$A$19"))
    
85.         .Name = _
    
86.         "CAGWEB.C_PCTHA272?pArea=000&pSCd=6006&pDayFlg=0&pDayFlg1=1&pSearchFlg=2&pCustFlg=02074160008"
    
87.         .FieldNames = True
    
88.         .RowNumbers = False
    
89.         .FillAdjacentFormulas = False
    
90.         .PreserveFormatting = True
    
91.         .RefreshOnFileOpen = False
    
92.         .BackgroundQuery = True
    
93.         .RefreshStyle = xlInsertDeleteCells
    
94.         .SavePassword = False
    
95.         .SaveData = True
    
96.         .AdjustColumnWidth = True
    
97.         .RefreshPeriod = 0
    
98.         .WebSelectionType = xlAllTables
    
99.         .WebFormatting = xlWebFormattingNone
    
100.         .WebPreFormattedTextToColumns = True
     
101.         .WebConsecutiveDelimitersAsOne = True
     
102.         .WebSingleBlockTextImport = False
     
103.         .WebDisableDateRecognition = False
     
104.         .WebDisableRedirections = False
     
105.         .Refresh BackgroundQuery:=False
     
106.     End With
     
107.     Dim URL As String, xDate As Date
     
108.    
     
109.     With ActiveSheet.QueryTables.Add(Connection:= _
     
110.         "URL;http://hct-apdev1.hct.com.tw:11235/HCT.AS400.Web/CargoTracking/CTGPS01R2.aspx?ScanDay=[color=Red]20131218[/color]&Stor=6006&StorDesc=%e5%8f%b0%e5%8d%97&CseNo=All&OpeCd=All" _
     
111.         , Destination:=Range("$A$1"))
     
112.         .Name = _
     
113.         "CTGPS01R2.aspx?ScanDay=[color=Red]20131218[/color]&Stor=6006&StorDesc=%e5%8f%b0%e5%8d%97&CseNo=All&OpeCd=All"
     
114.         .FieldNames = True
     
115.         .RowNumbers = False
     
116.         .FillAdjacentFormulas = False
     
117.         .PreserveFormatting = True
     
118.         .RefreshOnFileOpen = False
     
119.         .BackgroundQuery = True
     
120.         .RefreshStyle = xlInsertDeleteCells
     
121.         .SavePassword = False
     
122.         .SaveData = True
     
123.         .AdjustColumnWidth = True
     
124.         .RefreshPeriod = 0
     
125.         .WebSelectionType = xlSpecifiedTables
     
126.         .WebFormatting = xlWebFormattingNone
     
127.         .WebTables = "1"
     
128.         .WebPreFormattedTextToColumns = True
     
129.         .WebConsecutiveDelimitersAsOne = True
     
130.         .WebSingleBlockTextImport = False
     
131.         .WebDisableDateRecognition = False
     
132.         .WebDisableRedirections = False
     
133.         .Refresh BackgroundQuery:=False
     
134.     End With
     
135. End Sub

複製代碼

---

作者: s93213241    時間: 2013-12-21 13:52

本帖最後由 s93213241 於 2013-12-21 13:53 編輯

以自行解決

---

作者: handsometrowa    時間: 2013-12-24 09:14

回復 2# s93213241


    其實有看沒有懂

請問版大可否上傳檔案以茲大家學習領悟呢??

---

作者: s93213241    時間: 2013-12-24 14:22

本帖最後由 s93213241 於 2013-12-24 14:24 編輯

我檔案分享出來也沒有用@@  因為我在PO文一開始就說明 我公司室內網  一般民網連不上去

1.     Dim xDate As Date
   
2.     xDate = Date
   
3.     Range("Sheet2!$E$6").Value = (xDate)
   
4. 
   
5.     With ActiveSheet.QueryTables.Add(Connection:= _
   
6.         "URL;http://hct-apdev1.hct.com.tw:11235/HCT.AS400.Web/CargoTracking/CTGPS01R2.aspx?ScanDay=" & Format(xDate, "YYYYMMDD") & "&Stor=6006&StorDesc=%e5%8f%b0%e5%8d%97&CseNo=All&OpeCd=All" _
   
7.         , Destination:=Range("Sheet1!$A$25"))
   
8.         .Name = _
   
9.         "CTGPS01R2.aspx?ScanDay=" & Format(xDate, "YYYYMMDD") & "&Stor=6006&StorDesc=%e5%8f%b0%e5%8d%97&CseNo=All&OpeCd=All"
   
10.         .FieldNames = True
    
11.         .RowNumbers = False
    
12.         .FillAdjacentFormulas = False
    
13.         .PreserveFormatting = True
    
14.         .RefreshOnFileOpen = False
    
15.         .BackgroundQuery = True
    
16.         .RefreshStyle = xlInsertDeleteCells
    
17.         .SavePassword = False
    
18.         .SaveData = True
    
19.         .AdjustColumnWidth = True
    
20.         .RefreshPeriod = 0
    
21.         .WebSelectionType = xlSpecifiedTables
    
22.         .WebFormatting = xlWebFormattingNone
    
23.         .WebTables = "1"
    
24.         .WebPreFormattedTextToColumns = True
    
25.         .WebConsecutiveDelimitersAsOne = True
    
26.         .WebSingleBlockTextImport = False
    
27.         .WebDisableDateRecognition = False
    
28.         .WebDisableRedirections = False
    
29.         .Refresh BackgroundQuery:=False
    
30.     End With

複製代碼

以上這段我卡住比較久
" & Format(xDate, "YYYYMMDD") & " 用法

與

Dim xDate As Date
    xDate = Date

宣告當日時間   

剩下登入畫面我上網找人家PO出來的成品自己修改進去的

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)