登入船班網站, 輸入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.
有沒有其他的單號可以測試?
341640367172, 113047195860這兩筆也可以試試(主要是想抓取route 頁面裡面Local ETA的資料), thank you.
自己參詳一下,其中一張工作表改名為 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
太強了, 寫得很詳細, 受益良多!!
學好 vba 的 xmlhttp, 再配合 windows 的排程.有機會在上班前已經做好哂半日要做好的東西了.
比今朝多了一些東西
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
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.