EXCEL VBA TIPS

ファミマTカードの会員ページ> ご利用明細照会 > ご請求内容の明細
より各月の買い物一覧をexcelに取り込みます
前提：ワークシート：accountにTcard番号,パスワードがあること。Tcard番号：1行1列、パスワート：2行1列
動作：月ごとにご請求内容の明細をブラウズ
　　　　ワークシート名として、"年_月"の規則でワークシートを追加
　　　　追加したワークシートに一覧を取り込み
　　　　"年_月"ワークシートがある場合その時点で止める
以下ソースです
Sub Fichiran()
Dim objIE0 As Object
'対象画面を検索、なければ開く（必要に応じ使用してください）
Set xShell = CreateObject("Shell.Application")
win_s = False
For Each Window In xShell.Windows '対象URLが表示されているか？
If TypeName(Window.Document) = "HTMLDocument" Then
If Window.Document.URL = "https://portal.expay.net/servlet/FTPoLogin" Then
Set objIE0 = Window '対象URLが表示→その画面を使う
win_s = True
Exit For
End If
End If
Next
If win_s = False Then '対象URLが非表示→新しく画面を開く
Set objIE0 = CreateObject("InternetExplorer.Application")
objIE0.Visible = True
objIE0.Navigate "https://portal.expay.net/servlet/FTPoLogin"
Call ie_wait(objIE0)
End If
objIE0.Document.all.loginID.Value = Worksheets("account").Cells(1, 1).Value '"" ' Tカード番号
objIE0.Document.all.pswd.Value = Worksheets("account").Cells(2, 1).Value ' 暗証番号
objIE0.Document.links(0).Click 'javascript:loginServ('FTPoLogin',%20'login')
Call ie_wait(objIE0)
Call link_click(objIE0, "text_inc", "明細照会")
c = toridasi(objIE0)
objIE0.Document.all.menu1.selectedIndex = 1 ' （前月）:
objIE0.Document.all.menu1.fireEvent ("onchange")
Call ie_wait(objIE0)
Call link_click(objIE0, "text_inc", "明細照会")
c = toridasi(objIE0)
objIE0.Document.all.menu1.selectedIndex = 2 ' （前々月
objIE0.Document.all.menu1.fireEvent ("onchange")
Call ie_wait(objIE0)
Call link_click(objIE0, "text_inc", "明細照会")
c = toridasi(objIE0)
End Sub
Function toridasi(objIE As Object) As Integer
Dim s As String
toridasi = 0
s = objIE.Document.body.innerhtml
nen = strmid(s, "<OPTION selected>", "年")
tuki = strmid(s, "年", "月")
'tuki = strmid(s, ">", "<")
sheet_n = nen & "_" & tuki
On Error GoTo keke
Sheets(sheet_n).Activate
GoTo endd
keke:
On Error GoTo 0
toridasi = toridasi + 1
Set NewWS = Worksheets.Add '(After:=Worksheets("Sheet3"))
With NewWS
.Name = sheet_n
' .Columns.ColumnWidth = 20
End With
Sheets(sheet_n).Activate
s = strmid(s, "<TD class=text vAlign=top>ご利用明", "")
s_pos = 2
Do Until InStr(s, "<TD borderColor=#666666 align=middle>") = 0
mono = strmid(s, "<TD borderColor=#666666 align=middle>", "<")
yymmdd = strmid(s, "<TD borderColor=#666666 align=middle>", "<")
shop = strmid(s, "<TD borderColor=#666666>", "<")
gaku = strmid(s, "<TD borderColor=#666666 align=right>", "<")
Cells(s_pos, 1).Value = yymmdd
Cells(s_pos, 2).Value = shop
Cells(s_pos, 3).Value = gaku
s_pos = s_pos + 1
Loop
endd:
End Function
Function strmid(ByRef org As String, ByVal mae As String, ByVal usiro As String) As String
Pos = InStr(org, mae)
If Pos > 0 Then
strmid = Right(org, Len(org) - Pos - Len(mae) + 1)
org = strmid
Pos = InStr(strmid, usiro)
If usiro = "" Then
' strmid = ""
Else
If Pos > 0 Then
strmid = Left(strmid, Pos - 1)
End If
End If
Else
strmid = ""
End If
End Function
Function link_click(objIE As Object, typ As String, v As String) As Integer
link_click = -1
c = 0
For i = 0 To objIE.Document.links.Length - 1
If typ = "text" Then
If objIE.Document.links(i).outertext = v Then
objIE.Document.links(i).Click
Call ie_wait(objIE)
link_click = 0
Exit For
End If
End If
If typ = "text_inc" Then
If InStr(objIE.Document.links(i).outerHtml, v) > 0 Then
objIE.Document.links(i).Click
Call ie_wait(objIE)
link_click = 0
Exit For
End If
End If
If typ = "href" Then
If objIE.Document.links(i).href = v Then
objIE.Document.links(i).Click
Call ie_wait(objIE)
link_click = 0
Exit For
End If
End If
If typ = "href_inc" Then
If InStr(objIE.Document.links(i).href, v) > 0 Then
objIE.Document.links(i).Click
Call ie_wait(objIE)
link_click = 0
Exit For
End If
End If
If typ = "num" Then
c = c + 1
If c = CStr(v) Then
objIE.Document.links(i).Click
Call ie_wait(objIE)
link_click = 0
Exit For
End If
End If
Next
End Function
Function ie_wait(objIE As Object)
Do While objIE.Busy = True
DoEvents
Loop '
Do While objIE.Document.readyState <> "complete"
DoEvents
Loop
End Function