返回列表 上一主題 發帖

[發問] 第一次學用VBA抓取資料 遇到一些問題

s93213241

帖子
8 
主題
3 
精華
0 
積分
16 
點名
0  
作業系統
XP  
軟體版本
2007 OR 2010 
閱讀權限
10 
註冊時間
2013-12-18 
最後登錄
2014-1-28 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-12-19 01:18 | 只看該作者

[發問] 第一次學用VBA抓取資料 遇到一些問題

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

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

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

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

以上感謝看完此篇的有緣人 謝謝   假如有其他需要我補充說明的歡迎提出  因為並不能直接開網頁出來看結果
  1. Sub 巨集1()
  2. '
  3. ' 巨集1 巨集
  4. '

  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

帖子
8 
主題
3 
精華
0 
積分
16 
點名
0  
作業系統
XP  
軟體版本
2007 OR 2010 
閱讀權限
10 
註冊時間
2013-12-18 
最後登錄
2014-1-28 
2#
發表於 2013-12-21 13:52 | 只看該作者
本帖最後由 s93213241 於 2013-12-21 13:53 編輯

以自行解決

1480625_717490708269016_1593430672_n.jpg (92.79 KB)

1480625_717490708269016_1593430672_n.jpg

TOP

handsometrowa

帖子
82 
主題
7 
精華
0 
積分
112 
點名
0  
作業系統
WIN7 
軟體版本
WIN7 
閱讀權限
20 
性別
男 
註冊時間
2013-1-3 
最後登錄
2020-9-21 
3#
發表於 2013-12-24 09:14 | 只看該作者
回復 2# s93213241


    其實有看沒有懂

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

TOP

s93213241

帖子
8 
主題
3 
精華
0 
積分
16 
點名
0  
作業系統
XP  
軟體版本
2007 OR 2010 
閱讀權限
10 
註冊時間
2013-12-18 
最後登錄
2014-1-28 
4#
發表於 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)

  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出來的成品自己修改進去的

TOP

        靜思自在 : 滴水成河。粒米成蘿，勿輕己靈，勿以善小而不為。
返回列表 上一主題