削除

パスワードとIDで自動ログインしたWEBからテーブルデータをエクセルに抽出削除

Message#1 2017年12月25日(月)18時52分
From: 丹羽英人

本を購入させて戴いて、VBAでSUICAのIDとPasswordを自動的に入力して、テーブルをWEB上で表示させる事は出来たのですが、Tableデータをエクセル上に書き込む方法がうまくいきません。

既に自動で開いたWebを参照したいのと、Tableのデータを全て、エクセルに書き込みたいのですが、うまく出来ません。
宜しくお願いします。

下記が、エクセルに読み込みたいテーブルのデータと参考にしているVBAと自動ログインのVBAです。

</table>

<img src="/frsis/img/spacer.gif" width="1" height="15" border="0" alt="">
<table cellSpacing="0" cellPadding="0" width="545" border="0">

<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%">月/日</td>
<td style="border:1px solid gray" class="pad08 grybg02" align="center" width="13%">種別</td>
<td style="border:1px solid gray" class="pad08 grybg02" align="center" width="16%">利用場所</td>
<td style="border:1px solid gray" class="pad08 grybg02" align="center" width="13%">種別</td>
<td style="border:1px solid gray" class="pad08 grybg02" align="center" width="16%">利用場所</td>
<td style="border:1px solid gray" class="pad08 grybg02" align="center" width="15%">残額</td>
<td style="border:1px solid gray" class="pad08 grybg02" align="center" width="15%">差額</td>
</tr>
<tr><td style="border:1px solid gray" class="pad08 whtbg" align="center">12/24</td>
<td style="border:1px solid gray" class="pad08 whtbg" align="center">入</td>
<td style="border:1px solid gray" class="pad08 whtbg" align="center">川崎　　</td>
<td style="border:1px solid gray" class="pad08 whtbg" align="center">出</td>
<td style="border:1px solid gray" class="pad08 whtbg" align="center">蒲田　　</td>
<td style="border:1px solid gray" class="pad08 whtbg" align="right">¥13,492</td>
<td style="border:1px solid gray" class="pad08 whtbg" align="right">-154</td>
</tr><tr><td style="border:1px solid gray" class="pad08 whtbg" align="center">12/24</td>
<td style="border:1px solid gray" class="pad08 whtbg" align="center">入</td>
<td style="border:1px solid gray" class="pad08 whtbg" align="center">蒲田　　</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

上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。