パスワードとIDで自動ログインしたWEBからテーブルデータをエクセルに抽出
昨日以降(0) ２日前以降(0) ３日前以降(0) ４日前以降(0) ５日前以降(0)
| Message#1 2017年12月25日(月)18時52分 From: 丹羽英人 | 返事 削除 変更 |
| 本を購入させて戴いて、VBAでSUICAのIDとPasswordを自動的に入力して、テーブルをWEB上で表示させる事は出来たのですが、Tableデータをエクセル上に書き込む方法がうまくいきません。 既に自動で開いたWebを参照したいのと、Tableのデータを全て、エクセルに書き込みたいのですが、うまく出来ません。 宜しくお願いします。 下記が、エクセルに読み込みたいテーブルのデータと参考にしているVBAと自動ログインのVBAです。 </table> <!-- /■ 利用履歴を参照するSuica --> <p><img src="/frsis/img/spacer.gif" width="1" height="15" border="0" alt=""></p> <table cellSpacing="0" cellPadding="0" width="545" border="0"> <!-- ■ SF利用履歴 --> <tr> <td align="left"> <input type="image" height="28" alt="印刷(PDF)" width="106" src="/frsis/img/b_print.gif" border="0" name="PRINT"> </td> </tr> <tr> <td class="grybg01"> <table cellSpacing="0" cellPadding="8" width="545" border="0"> <tr> <td style="border:1px solid gray" class="pad08 grybg02" align="center" width="12%"><font class="tx-wht">月/日</font></td> <td style="border:1px solid gray" class="pad08 grybg02" align="center" width="13%"><font class="tx-wht">種別</font></td> <td style="border:1px solid gray" class="pad08 grybg02" align="center" width="16%"><font class="tx-wht">利用場所</font></td> <td style="border:1px solid gray" class="pad08 grybg02" align="center" width="13%"><font class="tx-wht">種別</font></td> <td style="border:1px solid gray" class="pad08 grybg02" align="center" width="16%"><font class="tx-wht">利用場所</font></td> <td style="border:1px solid gray" class="pad08 grybg02" align="center" width="15%"><font class="tx-wht">残額</font></td> <td style="border:1px solid gray" class="pad08 grybg02" align="center" width="15%"><font class="tx-wht">差額</font></td> </tr> <tr><td style="border:1px solid gray" class="pad08 whtbg" align="center"><font class="ml">12/24</font></td> <td style="border:1px solid gray" class="pad08 whtbg" align="center"><font class="ml">入</font></td> <td style="border:1px solid gray" class="pad08 whtbg" align="center"><font class="ml">川崎 </font></td> <td style="border:1px solid gray" class="pad08 whtbg" align="center"><font class="ml">出</font></td> <td style="border:1px solid gray" class="pad08 whtbg" align="center"><font class="ml">蒲田 </font></td> <td style="border:1px solid gray" class="pad08 whtbg" align="right"><font class="ml">¥13,492</font></td> <td style="border:1px solid gray" class="pad08 whtbg" align="right"><font class="ml">-154</font></td> </tr><tr><td style="border:1px solid gray" class="pad08 whtbg" align="center"><font class="ml">12/24</font></td> <td style="border:1px solid gray" class="pad08 whtbg" align="center"><font class="ml">入</font></td> <td style="border:1px solid gray" class="pad08 whtbg" align="center"><font class="ml">蒲田 </font></td> <td style="border:1px solid gray Sub GetTable4() Dim ie As InternetExplorer Dim Doc As HTMLDocument Dim ObjTag As Object Dim i As Long Dim n As Long Set ie = CreateObject("InternetExplorer.Application") ie.Visible = True ie.navigate "http://book.impress.co.jp/appended/3384/4-10_3.html" '"http://kakaku.com/pc/note-pc/se_15/" Do While ie.Busy Or ie.readyState < READYSTATE_COMPLETE DoEvents Loop Set Doc = ie.document Sheets("Sheet3").Select Cells.ClearContents Cells.NumberFormatLocal = "G/標準" For i = 537 To 855 If Doc.all(i).tagName = "TD" Then n = n + 1 Cells(Int((n - 1) / 16) + 1, (n - 1) Mod 16 + 1) = Doc.all(i).innerText End If Next i Cells.EntireColumn.AutoFit Cells.EntireRow.AutoFit End Sub 下記が、うまく動いている自動ログインのVBAです。 Option Explicit #If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long) #End If Sub SUICA2() Dim objIE As InternetExplorer Dim objInpTxt As HTMLInputTextElement Dim ObjTag As Object Dim SuicaID As String Dim SuicaPW As String Sheets("Main").Select SuicaID = Range("C6").Value SuicaPW = Range("C7").Value 'InternetExplorerでスイカのページを起動 Call ieView(objIE, "https://www.suicainternetservice.com/frmcsis/ka/cm/SISCheckGenerallyProgress.aspx?CLSendId=SFSCMMEPC01&CLRecvId=SFRIQIRPC34") 'ボックスにIDを入力 objIE.document.forms(1).CommonID.Value = SuicaID 'ボックスにPasswordを入力 objIE.document.forms(1).Password.Value = SuicaPW 'image(ボタン)をクリック For Each ObjTag In objIE.document.getElementsByTagName("input") If InStr(ObjTag.outerHTML, "My JR-EAST IDでログイン") > 0 Then 'imageボタンクリック ObjTag.Click 'IEが完全表示されるまで待機 Call ieCheck(objIE) 'ループ脱出 Exit For End If Next 'image(ボタン)をクリック For Each ObjTag In objIE.document.getElementsByTagName("input") If InStr(ObjTag.outerHTML, "次へ（内容確認）") > 0 Then 'imageボタンクリック ObjTag.Click 'IEが完全表示されるまで待機 Call ieCheck(objIE) 'ループ脱出 Exit For End If Next End Sub Sub ieView(objIE As InternetExplorer, _ urlName As String, _ Optional viewFlg As Boolean = True, _ Optional ieTop As Integer = 0, _ Optional ieLeft As Integer = 0, _ Optional ieWidth As Integer = 600, _ Optional ieHeight As Integer = 800) 'IE(InternetExplorer)のオブジェクトを作成する Set objIE = CreateObject("InternetExplorer.Application") With objIE 'IE(InternetExplorer)を表示・非表示 .Visible = viewFlg .Top = ieTop 'Y位置 .Left = ieLeft 'X位置 .Width = ieWidth '幅 .Height = ieHeight '高さ '指定したURLのページを表示する .navigate urlName End With 'IE(InternetExplorer)が完全表示されるまで待機 Call ieCheck(objIE) End Sub Sub ieCheck(objIE As InternetExplorer) Dim timeOut As Date '完全にページが表示されるまで待機する timeOut = Now + TimeSerial(0, 0, 20) Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Sleep 1 If Now > timeOut Then objIE.Refresh timeOut = Now + TimeSerial(0, 0, 20) End If Loop timeOut = Now + TimeSerial(0, 0, 20) Do While objIE.document.readyState <> "complete" DoEvents Sleep 1 If Now > timeOut Then objIE.Refresh timeOut = Now + TimeSerial(0, 0, 20) End If Loop End Sub Sub LoginClick() Dim ObjTag As Object 'image(ボタン)をクリック For Each ObjTag In objIE.document.getElementsByTagName("input") If InStr(ObjTag.outerHTML, "My JR-EAST IDでログイン") > 0 Then 'imageボタンクリック ObjTag.Click 'IEが完全表示されるまで待機 Call ieCheck(objIE) 'ループ脱出 Exit For End If Next End Sub |
昨日以降 ２日前以降 ３日前以降 ４日前以降 ５日前以降
