PR
キーワードサーチ
▼キーワード検索
EXCEL VBA TIPS
わたしのブログへようこそ
カレンダー
コメント新着
フリーページ
2009.01.28
テーマ： パソコン講師(288)
カテゴリ： カテゴリ未分類
OMCカードの会員ページOMC Plus Top > ご利用明細 > ご請求内容の明細
より各月の買い物一覧をexcelに取り込みます
前提：OMC@Plus会員専用インターネットサービスのidがあること
ワークシート：accountにid,パスワードがあること。Id：1行1列、パスワート：2行1列
動作：月ごとにご請求内容の明細をブラウズ
ワークシート名として、"年_月"の規則でワークシートを追加
追加したワークシートに一覧を取り込み
"年_月"ワークシートがある場合その時点で止める
以下ソースです
Dim objIE0 As Object 'ルートのオブジェクト、操作コードではこの名称を使用します
Dim objIE1 As Object, objIE2 As Object 'FRAMEのオブジェクト、ネストが3重以上になる場合は、objIE3,objIE4・・・を追加してください
Dim s As String, nn As Integer
'対象画面を検索、なければ開く（必要に応じ使用してください）
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://ca.omc-card.co.jp/member/omcplus_login.html" Then
Set objIE0 = Window '対象URLが表示→その画面を使う
win_s = True
End If
End If
Next
If win_s = False Then '対象URLが非表示→新しく画面を開く
Set objIE0 = CreateObject("InternetExplorer.Application")
objIE0.navigate "https://ca.omc-card.co.jp/member/omcplus_login.html"
Do While objIE0.Busy = True
DoEvents
Loop
Do While objIE0.Document.readyState <> "complete"
DoEvents
Loop
End If
'---header end---
'---以下操作コード、必要な部分をコピーしてください---
objIE0.Document.all.sid_input.Value = Worksheets("account").Cells(1, 1).Value ' text index=2
objIE0.Document.all.pw_input.Value = Worksheets("account").Cells(2, 1).Value ' password index=3
objIE0.Document.links(0).Click 'javascript:checkInput(document.form1);
Call ie_wait(objIE0)
Dim meisai(6) As String
j = 0
Call link_click(objIE0, "text_inc", "ご利用代金明細照会")
For i = 0 To objIE0.Document.links.Length - 1
link_s = objIE0.Document.links(i).href
If InStr(link_s, "xt_details_inquiry.asp") > 0 Then
meisai(j) = objIE0.Document.links(i).href
j = j + 1
'objIE0.navigate objIE0.Document.links(i).href
'objIE0.Document.links(i).Click
End If
Next
For i = 0 To j - 1
objIE0.navigate meisai(i)
Call ie_wait(objIE0)
nn = toridasi(objIE0)
If nn = 0 Then
Application.StatusBar = "取り込み済み"
Exit For
End If
Next
End Sub
Function toridasi(objIE As Object) As Integer
Dim s As String
toridasi = 0
s = objIE.Document.body.innerhtml
nen = strmid(s, "<TD id=goriyou_txt><STRONG>", "<")
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, "カードショッピング", "")
s_pos = 2
Do Until InStr(s, "ゴシック"">") = 0
mono = strmid(s, "ゴシック"">", "<")
mono = Replace(mono, ". ", ".")
mono = Replace(mono, " ", " ")
r = 1
sd = ""
For j = 1 To Len(mono)
If Mid(mono, j, 1) = " " Then
If Len(sd) > 0 Then
Cells(s_pos, r).Value = sd
r = r + 1
sd = ""
End If
Else
sd = sd & Mid(mono, j, 1)
End If
Next
If Len(sd) > 0 Then Cells(s_pos, r).Value = sd
s_pos = s_pos + 1
'nengetu = strmid(s, "> ", " ")
'hi = strmid(s, "", " ")
'mise = strmid(s, "", " ")
'gaku = strmid(s, "", " ")
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).outertext, 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
より各月の買い物一覧をexcelに取り込みます
前提：OMC@Plus会員専用インターネットサービスのidがあること
ワークシート：accountにid,パスワードがあること。Id：1行1列、パスワート：2行1列
動作：月ごとにご請求内容の明細をブラウズ
ワークシート名として、"年_月"の規則でワークシートを追加
追加したワークシートに一覧を取り込み
"年_月"ワークシートがある場合その時点で止める
以下ソースです
Dim objIE0 As Object 'ルートのオブジェクト、操作コードではこの名称を使用します
Dim objIE1 As Object, objIE2 As Object 'FRAMEのオブジェクト、ネストが3重以上になる場合は、objIE3,objIE4・・・を追加してください
Dim s As String, nn As Integer
'対象画面を検索、なければ開く（必要に応じ使用してください）
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://ca.omc-card.co.jp/member/omcplus_login.html" Then
Set objIE0 = Window '対象URLが表示→その画面を使う
win_s = True
End If
End If
Next
If win_s = False Then '対象URLが非表示→新しく画面を開く
Set objIE0 = CreateObject("InternetExplorer.Application")
objIE0.navigate "https://ca.omc-card.co.jp/member/omcplus_login.html"
Do While objIE0.Busy = True
DoEvents
Loop
Do While objIE0.Document.readyState <> "complete"
DoEvents
Loop
End If
'---header end---
'---以下操作コード、必要な部分をコピーしてください---
objIE0.Document.all.sid_input.Value = Worksheets("account").Cells(1, 1).Value ' text index=2
objIE0.Document.all.pw_input.Value = Worksheets("account").Cells(2, 1).Value ' password index=3
objIE0.Document.links(0).Click 'javascript:checkInput(document.form1);
Call ie_wait(objIE0)
Dim meisai(6) As String
j = 0
Call link_click(objIE0, "text_inc", "ご利用代金明細照会")
For i = 0 To objIE0.Document.links.Length - 1
link_s = objIE0.Document.links(i).href
If InStr(link_s, "xt_details_inquiry.asp") > 0 Then
meisai(j) = objIE0.Document.links(i).href
j = j + 1
'objIE0.navigate objIE0.Document.links(i).href
'objIE0.Document.links(i).Click
End If
Next
For i = 0 To j - 1
objIE0.navigate meisai(i)
Call ie_wait(objIE0)
nn = toridasi(objIE0)
If nn = 0 Then
Application.StatusBar = "取り込み済み"
Exit For
End If
Next
End Sub
Function toridasi(objIE As Object) As Integer
Dim s As String
toridasi = 0
s = objIE.Document.body.innerhtml
nen = strmid(s, "<TD id=goriyou_txt><STRONG>", "<")
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, "カードショッピング", "")
s_pos = 2
Do Until InStr(s, "ゴシック"">") = 0
mono = strmid(s, "ゴシック"">", "<")
mono = Replace(mono, ". ", ".")
mono = Replace(mono, " ", " ")
r = 1
sd = ""
For j = 1 To Len(mono)
If Mid(mono, j, 1) = " " Then
If Len(sd) > 0 Then
Cells(s_pos, r).Value = sd
r = r + 1
sd = ""
End If
Else
sd = sd & Mid(mono, j, 1)
End If
Next
If Len(sd) > 0 Then Cells(s_pos, r).Value = sd
s_pos = s_pos + 1
'nengetu = strmid(s, "> ", " ")
'hi = strmid(s, "", " ")
'mise = strmid(s, "", " ")
'gaku = strmid(s, "", " ")
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).outertext, 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
お気に入りの記事を「いいね！」で応援しよう
【毎日開催】
15記事にいいね！で1ポイント
© Rakuten Group, Inc.
