iT邦幫忙

0

利用Excel VBA 點擊 網頁中的子網頁(href="javascript:showTab(2)), 並下載其資料到Excel

excel vba #javascript
bzboy 2021-12-15 16:00:17 ‧ 1403 瀏覽

  • 分享至 

  • xImage

登入船班網站, 輸入tracking, 查詢航班資訊, 並將其網頁資料回寫到Excel
船班網站 : https://css.kwe.com/
測試用的tracking:550141227483
目前可以用ExcelVBA自動丟tracking到船班網站查詢到船班資訊, 編碼如下:
Sub find_Shipmenet()

theURL = "https://css.kwe.com/"

shipmenet_number = "550141227483"

If Len(shipmenet_number) = 0 Then
    MsgBox "請輸入tracking"
Else
    With CreateObject("InternetExplorer.Application")
    .Visible = True
    .navigate theURL
    
    Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
    With .document
        .all("answer1").Value = shipmenet_number
        .all("submitTrackBtn").Click
    End With
    
    End With
    
End If

End Sub

目前遇到的問題:
跑完後會出現5個分頁(Shipment/Route/Milestones/Reference/Remarks),不知道該如何點擊選擇第2個分頁(Route), 並將其網頁資料回寫EXcel.

341640367172, 113047195860這兩筆也可以試試(主要是想抓取route 頁面裡面Local ETA的資料), thank you.

登入發表討論
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

1 個回答

0
blanksoul12
iT邦研究生 5 級 ‧ 2021-12-16 08:57:11
最佳解答

有沒有其他的單號可以測試?

看更多先前的回應...收起先前的回應...
bzboy iT邦新手 5 級 ‧ 2021-12-16 09:40:48 檢舉

341640367172, 113047195860這兩筆也可以試試(主要是想抓取route 頁面裡面Local ETA的資料), thank you.

blanksoul12 iT邦研究生 5 級 ‧ 2021-12-16 11:13:38 檢舉

自己參詳一下,其中一張工作表改名為 Result

Sub test()

check_no = "113047195860"

With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", "https://css.kwe.com/", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send
    
    .Open "POST", "https://css.kwe.com/WaybillLoginAction.do", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send "mode=W&waybillNo=" & check_no & "&pageName=L&uid=&pwd=&answer1=" & check_no & "&mode1=W"
    
    .Open "GET", "https://css.kwe.com/WaybillTracking.jsp", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .setRequestHeader "Referer", "https://css.kwe.com/WaybillLoginAction.do"
    .Send
    
    strText = .responsetext
    CopyToClipbox (strText)
    
    Set temp_ie = CreateObject("htmlfile")
    temp_ie.Write .responsetext
    
    Worksheets("result").Cells.Clear
    Set item_name = temp_ie.DocumentElement.all.tags("table")(5).all.tags("td")
    For a = 0 To item_name.Length - 1
        If InStr(item_name(a).classname, "label_margin") > 0 Then
            Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = item_name(a).innertext
        End If
    Next
    
    Set shipment = temp_ie.DocumentElement.all.tags("table")(5).all.tags("input")
    For a = 0 To shipment.Length - 1
        Worksheets("result").[b1048576].End(xlUp).Offset(1, 0) = "'" & shipment(a).Value
    Next
    
    'for Route
    mwb_num = Worksheets("result").Cells.Find("Status", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    wb_type_1 = Worksheets("result").Cells.Find("Shipment Type", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    tmode_1 = Worksheets("result").Cells.Find("Transport Mode", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    wb_type_2 = Worksheets("result").Cells.Find("Origin", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    tmode_2 = Worksheets("result").Cells.Find("Destination", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    wb_type_3 = Worksheets("result").Cells.Find("Place of Receipt", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    tmode_3 = Worksheets("result").Cells.Find("Place of Delivery", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    no_pieces = Worksheets("result").Cells.Find("No of Pieces", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    chargeable_weight = Worksheets("result").Cells.Find("Chargeable Weight", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    actual_weight = Worksheets("result").Cells.Find("Actual Weight", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    bill_type = Worksheets("result").Cells.Find("Billing", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    s_level = Worksheets("result").Cells.Find("Service Type", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    
    Set pid_value = temp_ie.DocumentElement.all.tags("input")
    For a = 0 To pid_value.Length - 1
        If pid_value(a).Name = "PID" Then
            pid_value = pid_value(a).Value
            Exit For
        End If
    Next
    
    Set kr_value = temp_ie.DocumentElement.all.tags("input")
    For a = 0 To kr_value.Length - 1
        If kr_value(a).Name = "orgCtryNew" Then
            kr_value = kr_value(a).Value
            Exit For
        End If
    Next
    
    send_data = "PID=" & pid_value
    send_data = send_data & "&" & "answer=" & check_no
    send_data = send_data & "&" & "answerNew="
    send_data = send_data & "&" & "orgCountry="
    send_data = send_data & "&" & "orgCtryNew=" & kr_value
    send_data = send_data & "&" & "hwb_num=" & check_no
    send_data = send_data & "&" & "mwb_num=" & mwb_num
    send_data = send_data & "&" & "wb_type=" & wb_type_1
    send_data = send_data & "&" & "tmode=" & tmode_1
    send_data = send_data & "&" & "wb_type=" & wb_type_2
    send_data = send_data & "&" & "tmode=" & tmode_2
    send_data = send_data & "&" & "wb_type=" & wb_type_3
    send_data = send_data & "&" & "tmode=" & tmode_3
    send_data = send_data & "&" & "no_pieces=" & no_pieces
    send_data = send_data & "&" & "chargeable_weight=" & chargeable_weight
    send_data = send_data & "&" & "actual_weight=" & actual_weight
    send_data = send_data & "&" & "bill_type=" & bill_type
    send_data = send_data & "&" & "s_level=" & s_level
    
    .Open "POST", "https://css.kwe.com/WbLoginRouteAction.do", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .setRequestHeader "Referer", "https://css.kwe.com/WaybillTracking.jsp"
    .Send Replace(send_data, " ", "+")
    
    Set temp_ie = CreateObject("htmlfile")
    temp_ie.Write .responsetext
    
    Set route_name_booked_header = temp_ie.DocumentElement.all.tags("table")(7).all.tags("th")
    For a = 0 To route_name_booked_header.Length - 1
        Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = route_name_booked_header(a).innertext
    Next
    Set route_name_booked_value = temp_ie.DocumentElement.all.tags("table")(7).all.tags("td")
    For a = 0 To route_name_booked_value.Length - 1
        Worksheets("result").[b1048576].End(xlUp).Offset(1, 0) = route_name_booked_value(a).innertext
    Next
    
    'for Milestones
    send_data = "PID=" & pid_value
    send_data = send_data & "&" & "answer=" & check_no
    send_data = send_data & "&" & "answerNew=" & check_no
    send_data = send_data & "&" & "orgCtryNew=" & kr_value
    send_data = send_data & "&" & "orgCountry=" & kr_value
    
    .Open "POST", "https://css.kwe.com/MilestoneWbLoginAction.do", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send Replace(send_data, " ", "+")
    
    Set temp_ie = CreateObject("htmlfile")
    temp_ie.Write .responsetext
    
    Set milestones_header = temp_ie.DocumentElement.all.tags("table")(5).all.tags("th")
    last_row = Worksheets("result").[a1048576].End(xlUp).Row
    For a = 0 To milestones_header.Length - 1
        Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = milestones_header(a).innertext
    Next
    Set milestones_value = temp_ie.DocumentElement.all.tags("table")(5).all.tags("td")
    item_count = 1
    For a = 0 To milestones_value.Length - 1
        column_count = WorksheetFunction.RoundUp(item_count / 5, 0)
        Worksheets("result").Cells(last_row + 1, column_count + 1) = milestones_value(a).innertext
        last_row = last_row + 1
        If item_count Mod 5 = 0 Then
            last_row = last_row - 5
        End If
        item_count = item_count + 1
    Next
    
    'for Reference
    send_data = "PID=" & pid_value
    send_data = send_data & "&" & "answer=" & check_no
    send_data = send_data & "&" & "answerNew=" & pid_value
    send_data = send_data & "&" & "orgCtryNew=" & kr_value
    send_data = send_data & "&" & "orgCountry=" & kr_value
    
    .Open "POST", "https://css.kwe.com/RefWbLoginAction.do", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send Replace(send_data, " ", "+")
    
    Set temp_ie = CreateObject("htmlfile")
    temp_ie.Write .responsetext
    
    last_row = Worksheets("result").[a1048576].End(xlUp).Row
    Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = "Type"
    Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = "Number"
    
    Set reference_value = temp_ie.DocumentElement.all.tags("table")(5).all.tags("td")
    item_count = 1
    For a = 0 To reference_value.Length - 1
        column_count = WorksheetFunction.RoundUp(item_count / 2, 0)
        Worksheets("result").Cells(last_row + 1, column_count + 1) = reference_value(a).innertext
        last_row = last_row + 1
        If item_count Mod 2 = 0 Then
            last_row = last_row - 2
        End If
        item_count = item_count + 1
    Next
    
    MsgBox "Finished"
    
End With

End Sub
Function CopyToClipbox(strText)

    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText strText
        .PutInClipboard
    End With
    
End Function
blanksoul12 iT邦研究生 5 級 ‧ 2021-12-16 11:14:31 檢舉

有興趣便往對岸看看這個
https://club.excelhome.net/thread-1159783-1-1.html

bzboy iT邦新手 5 級 ‧ 2021-12-16 14:14:51 檢舉

太強了, 寫得很詳細, 受益良多!!

blanksoul12 iT邦研究生 5 級 ‧ 2021-12-16 14:29:49 檢舉

學好 vba 的 xmlhttp, 再配合 windows 的排程.有機會在上班前已經做好哂半日要做好的東西了.

blanksoul12 iT邦研究生 5 級 ‧ 2021-12-16 14:36:56 檢舉

比今朝多了一些東西
update 一下

Sub test()

check_no = "550141227483"

With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", "https://css.kwe.com/", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send
    
    .Open "POST", "https://css.kwe.com/WaybillLoginAction.do", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send "mode=W&waybillNo=" & check_no & "&pageName=L&uid=&pwd=&answer1=" & check_no & "&mode1=W"
    
    .Open "GET", "https://css.kwe.com/WaybillTracking.jsp", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .setRequestHeader "Referer", "https://css.kwe.com/WaybillLoginAction.do"
    .Send
    
    strText = .responsetext
    CopyToClipbox (strText)
    
    Set temp_ie = CreateObject("htmlfile")
    temp_ie.Write .responsetext
    
    Worksheets("result").Cells.Clear
    Set item_name = temp_ie.DocumentElement.all.tags("table")(5).all.tags("td")
    For a = 0 To item_name.Length - 1
        If InStr(item_name(a).classname, "label_margin") > 0 Then
            Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = item_name(a).innertext
        End If
    Next
    
    Set shipment = temp_ie.DocumentElement.all.tags("table")(5).all.tags("input")
    For a = 0 To shipment.Length - 1
        Worksheets("result").[b1048576].End(xlUp).Offset(1, 0) = "'" & shipment(a).Value
    Next
    
    'for Route
    mwb_num = Worksheets("result").Cells.Find("Status", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    wb_type_1 = Worksheets("result").Cells.Find("Shipment Type", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    tmode_1 = Worksheets("result").Cells.Find("Transport Mode", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    wb_type_2 = Worksheets("result").Cells.Find("Origin", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    tmode_2 = Worksheets("result").Cells.Find("Destination", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    wb_type_3 = Worksheets("result").Cells.Find("Place of Receipt", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    tmode_3 = Worksheets("result").Cells.Find("Place of Delivery", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    no_pieces = Worksheets("result").Cells.Find("No of Pieces", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    chargeable_weight = Worksheets("result").Cells.Find("Chargeable Weight", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    actual_weight = Worksheets("result").Cells.Find("Actual Weight", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    bill_type = Worksheets("result").Cells.Find("Billing", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    s_level = Worksheets("result").Cells.Find("Service Type", LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1)
    
    Set pid_value = temp_ie.DocumentElement.all.tags("input")
    For a = 0 To pid_value.Length - 1
        If pid_value(a).Name = "PID" Then
            pid_value = pid_value(a).Value
            Exit For
        End If
    Next
    
    Set kr_value = temp_ie.DocumentElement.all.tags("input")
    For a = 0 To kr_value.Length - 1
        If kr_value(a).Name = "orgCtryNew" Then
            kr_value = kr_value(a).Value
            Exit For
        End If
    Next
    
    send_data = "PID=" & pid_value
    send_data = send_data & "&" & "answer=" & check_no
    send_data = send_data & "&" & "answerNew="
    send_data = send_data & "&" & "orgCountry="
    send_data = send_data & "&" & "orgCtryNew=" & kr_value
    send_data = send_data & "&" & "hwb_num=" & check_no
    send_data = send_data & "&" & "mwb_num=" & mwb_num
    send_data = send_data & "&" & "wb_type=" & wb_type_1
    send_data = send_data & "&" & "tmode=" & tmode_1
    send_data = send_data & "&" & "wb_type=" & wb_type_2
    send_data = send_data & "&" & "tmode=" & tmode_2
    send_data = send_data & "&" & "wb_type=" & wb_type_3
    send_data = send_data & "&" & "tmode=" & tmode_3
    send_data = send_data & "&" & "no_pieces=" & no_pieces
    send_data = send_data & "&" & "chargeable_weight=" & chargeable_weight
    send_data = send_data & "&" & "actual_weight=" & actual_weight
    send_data = send_data & "&" & "bill_type=" & bill_type
    send_data = send_data & "&" & "s_level=" & s_level
    
    .Open "POST", "https://css.kwe.com/WbLoginRouteAction.do", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .setRequestHeader "Referer", "https://css.kwe.com/WaybillTracking.jsp"
    .Send Replace(send_data, " ", "+")
    
    Set temp_ie = CreateObject("htmlfile")
    temp_ie.Write .responsetext
    
    Set route_name_actual_header = temp_ie.DocumentElement.all.tags("table")(7).all.tags("th")
    For a = 0 To route_name_actual_header.Length - 1
        Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = "Actual - " & route_name_actual_header(a).innertext
    Next
    Set route_name_actual_value = temp_ie.DocumentElement.all.tags("table")(7).all.tags("td")
    For a = 0 To route_name_actual_value.Length - 1
        Worksheets("result").[b1048576].End(xlUp).Offset(1, 0) = route_name_actual_value(a).innertext
    Next
    
    last_row = Worksheets("result").[a1048576].End(xlUp).Row
    Set route_name_booked_header = temp_ie.DocumentElement.all.tags("table")(7).all.tags("th")
    For a = 0 To route_name_booked_header.Length - 1
        Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = "Booked - " & route_name_booked_header(a).innertext
    Next
    Set route_name_booked_value = temp_ie.DocumentElement.all.tags("table")(7).all.tags("td")
    For a = 0 To route_name_booked_value.Length - 1
        Worksheets("result").Cells(last_row + 1, "b") = route_name_booked_value(a).innertext
        last_row = last_row + 1
    Next
    
    'for Milestones
    send_data = "PID=" & pid_value
    send_data = send_data & "&" & "answer=" & check_no
    send_data = send_data & "&" & "answerNew=" & check_no
    send_data = send_data & "&" & "orgCtryNew=" & kr_value
    send_data = send_data & "&" & "orgCountry=" & kr_value
    
    .Open "POST", "https://css.kwe.com/MilestoneWbLoginAction.do", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send Replace(send_data, " ", "+")
    
    Set temp_ie = CreateObject("htmlfile")
    temp_ie.Write .responsetext
    
    Set milestones_header = temp_ie.DocumentElement.all.tags("table")(5).all.tags("th")
    last_row = Worksheets("result").[a1048576].End(xlUp).Row
    For a = 0 To milestones_header.Length - 1
        Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = milestones_header(a).innertext
    Next
    Set milestones_value = temp_ie.DocumentElement.all.tags("table")(5).all.tags("td")
    item_count = 1
    For a = 0 To milestones_value.Length - 1
        column_count = WorksheetFunction.RoundUp(item_count / 5, 0)
        Worksheets("result").Cells(last_row + 1, column_count + 1) = milestones_value(a).innertext
        last_row = last_row + 1
        If item_count Mod 5 = 0 Then
            last_row = last_row - 5
        End If
        item_count = item_count + 1
    Next
    
    'for Reference
    send_data = "PID=" & pid_value
    send_data = send_data & "&" & "answer=" & check_no
    send_data = send_data & "&" & "answerNew=" & pid_value
    send_data = send_data & "&" & "orgCtryNew=" & kr_value
    send_data = send_data & "&" & "orgCountry=" & kr_value
    
    .Open "POST", "https://css.kwe.com/RefWbLoginAction.do", False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send Replace(send_data, " ", "+")
    
    Set temp_ie = CreateObject("htmlfile")
    temp_ie.Write .responsetext
    
    last_row = Worksheets("result").[a1048576].End(xlUp).Row
    Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = "Type"
    Worksheets("result").[a1048576].End(xlUp).Offset(1, 0) = "Number"
    
    Set reference_value = temp_ie.DocumentElement.all.tags("table")(5).all.tags("td")
    item_count = 1
    For a = 0 To reference_value.Length - 1
        column_count = WorksheetFunction.RoundUp(item_count / 2, 0)
        Worksheets("result").Cells(last_row + 1, column_count + 1) = reference_value(a).innertext
        last_row = last_row + 1
        If item_count Mod 2 = 0 Then
            last_row = last_row - 2
        End If
        item_count = item_count + 1
    Next
    
    MsgBox "Finished"
    
End With

End Sub
Function CopyToClipbox(strText)

    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText strText
        .PutInClipboard
    End With
    
End Function
bzboy iT邦新手 5 級 ‧ 2021-12-17 11:16:50 檢舉

hi 大大, 如果我現在想選Reference#查航班資訊(上述的例子是選KWE Waybill#),我剛剛試過把mode=W改成R(.Send "mode=R&waybillNo=" & check_no & "&pageName=L&uid=&pwd=&answer1=" & check_no & "&mode1=R")好像不行, 不知道哪邊還須要做修正.
如果選Reference#(單號需要用:X100000002491786/X100000002491376/X100000002517520做測試) 請高手指教一下, thank you.

bzboy iT邦新手 5 級 ‧ 2021-12-17 13:57:06 檢舉

我找到原因了, WaybillLoginAction.do要改成ReferenceLoginAction.do

blanksoul12 iT邦研究生 5 級 ‧ 2021-12-17 14:14:09 檢舉

Good /images/emoticon/emoticon12.gif
我沒太研究,你自己多學多試多做,自己幫自己吧

bzboy iT邦新手 5 級 ‧ 2021-12-17 15:16:30 檢舉

接下來抓航空業的資料試試, 到時遇到瓶頸可能又要問你了 > <

登入發表回應

我要發表回答

立即登入回答
iThome鐵人賽
參賽組數
1123 組
團體組數
52 組
累計文章數
23096 篇
完賽人數
656 人
iT+看影片追技術 看影片追技術 看更多
熱門tag 看更多
15th鐵人賽 13th鐵人賽 14th鐵人賽 12th鐵人賽 11th鐵人賽 鐵人賽 2019鐵人賽 2018鐵人賽 javascript 2017鐵人賽 python windows php c# windows server linux css 程式設計 react vue.js
熱門問題
熱門回答
熱門文章
IT邦幫忙