PR
キーワードサーチ
▼キーワード検索
EXCEL VBA TIPS
わたしのブログへようこそ
カレンダー
コメント新着
フリーページ
2009.05.12
テーマ： パソコン講師(288)
カテゴリ： カテゴリ未分類
Dim nyuukin(100) As nyuukin_row
Dim fno_w As Integer, a(999, 5) As String, a_no As Integer, hinichi As String, kingaku As String
Dim objIE As Object 'ＩＥオブジェクト参照用
Sheets("入金").Select
'On Error GoTo keke
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
objIE.navigate "https://direct.jp-bank.japanpost.jp/direct_login.html"
id = Worksheets("account").Cells(2, 2) ' text index=2
objIE.Document.all.okyakusamaBangou1.Value = Left(id, 4) ' text index=2
objIE.Document.all.okyakusamaBangou2.Value = Mid(id, 5, 4) ' text index=3
objIE.Document.all.okyakusamaBangou3.Value = Mid(id, 9, 5) ' text index=4
objIE.Document.all.loginPassword.Value = "" ' password index=5
objIE.Document.all.loginPassword.Value = Worksheets("account").Cells(3, 2) ' password index=3
objIE.Document.all.U010103.Click ' or tags("INPUT").item(7).Click
' objIE.Document.all.tags("INPUT").Item(5).Click
Call ie_wait(objIE)
objIE.Document.all.tags("INPUT").Item(4).Click '取扱内容照会
Call ie_wait(objIE)
objIE.Document.all.U070102.Click ' button U070102 次へ or tags("INPUT").item(23).Click
Call ie_wait(objIE)
kensuu = 0
Do
ii = t_Array(objIE, 0, fno_w, 1, a, a_no)
If Left(a(ii, 3), 2) = "送金" Then
kingaku = a(ii, 1)
kingaku = strmid(kingaku, ";", "<")
kingaku = Replace(kingaku, "円", "")
'kingaku = Replace(kingaku, ",", "")
nyuukin(kensuu).kingaku = kingaku
hinichi = a(ii, 0)
hinichi = Replace(hinichi, "-", "/")
nengo = Left(hinichi, 2)
seireki = CInt(nengo) + 1988
hinichi = Replace(hinichi, nengo, seireki, , 1)
hinichi = Replace(hinichi, " ", "")
nyuukin(kensuu).hinichi = DateValue(hinichi)
namae = a(ii, 3)
namae = Replace(namae, " ", "")
namae = Replace(namae, "送金 ", "")
nyuukin(kensuu).namae = namae
kensuu = kensuu + 1
End If
Next
s = objIE.Document.body.innerhtml
If InStr(s, "value=次を表示 name=U070202") = 0 Then Exit Do
'On Error Resume Next
objIE.Document.all.U070202.Click ' button U070202 次を表示 or tags("INPUT").item(2).Click
' On Error GoTo 0
' If Err.Description <> "" Then
' Err.Clear
' Exit Do
'End If
Call ie_wait(objIE)
Loop
If kensuu < 0 Then
Application.StatusBar = "ログインでエラーが発生しました"
Else
If kensuu = 0 Then
Application.StatusBar = "新規受入はありません"
Else
Dim nyuukin_old As nyuukin_row
'最後の取り込みを探す
i = 2
nyuukin_old.hinichi = ""
nyuukin_old.kingaku = 0
nyuukin_old.namae = ""
Do Until Cells(i, 5).Value = "" '入金一覧サーチ
If Cells(i, 5).Value = "郵貯" Then
nyuukin_old.hinichi = Worksheets("入金").Cells(i, 2).Value
nyuukin_old.kingaku = Worksheets("入金").Cells(i, 3).Value
nyuukin_old.namae = Worksheets("入金").Cells(i, 4).Value
Exit Do
End If
i = i + 1
Loop
kaisi = 0
If nyuukin_old.kingaku > 0 Then
For i = 0 To kensuu - 1
If nyuukin_old.hinichi = nyuukin(i).hinichi And nyuukin_old.kingaku = nyuukin(i).kingaku And nyuukin_old.namae = nyuukin(i).namae Then
kaisi = i + 1
Exit For
End If
Next
Else '郵貯 初取り込み
End If
For i = kaisi To kensuu - 1
If nyuukin_old.hinichi = nyuukin(i).hinichi And nyuukin_old.kingaku = nyuukin(i).kingaku And nyuukin_old.namae = nyuukin(i).namae Then
Exit For
Else
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Selection.RowHeight = 13.5
Cells(2, 2).Value = nyuukin(i).hinichi
Cells(2, 4).Value = nyuukin(i).namae
Cells(2, 3).Value = nyuukin(i).kingaku
Cells(2, 5).Value = "郵貯"
End If
Next
'Rows("2:2").Select
Application.StatusBar = "郵貯より" & kensuu - kaisi & "件の入金を取り込みました"
End If
End If
Dim fno_w As Integer, a(999, 5) As String, a_no As Integer, hinichi As String, kingaku As String
Dim objIE As Object 'ＩＥオブジェクト参照用
Sheets("入金").Select
'On Error GoTo keke
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
objIE.navigate "https://direct.jp-bank.japanpost.jp/direct_login.html"
id = Worksheets("account").Cells(2, 2) ' text index=2
objIE.Document.all.okyakusamaBangou1.Value = Left(id, 4) ' text index=2
objIE.Document.all.okyakusamaBangou2.Value = Mid(id, 5, 4) ' text index=3
objIE.Document.all.okyakusamaBangou3.Value = Mid(id, 9, 5) ' text index=4
objIE.Document.all.loginPassword.Value = "" ' password index=5
objIE.Document.all.loginPassword.Value = Worksheets("account").Cells(3, 2) ' password index=3
objIE.Document.all.U010103.Click ' or tags("INPUT").item(7).Click
' objIE.Document.all.tags("INPUT").Item(5).Click
Call ie_wait(objIE)
objIE.Document.all.tags("INPUT").Item(4).Click '取扱内容照会
Call ie_wait(objIE)
objIE.Document.all.U070102.Click ' button U070102 次へ or tags("INPUT").item(23).Click
Call ie_wait(objIE)
kensuu = 0
Do
ii = t_Array(objIE, 0, fno_w, 1, a, a_no)
If Left(a(ii, 3), 2) = "送金" Then
kingaku = a(ii, 1)
kingaku = strmid(kingaku, ";", "<")
kingaku = Replace(kingaku, "円", "")
'kingaku = Replace(kingaku, ",", "")
nyuukin(kensuu).kingaku = kingaku
hinichi = a(ii, 0)
hinichi = Replace(hinichi, "-", "/")
nengo = Left(hinichi, 2)
seireki = CInt(nengo) + 1988
hinichi = Replace(hinichi, nengo, seireki, , 1)
hinichi = Replace(hinichi, " ", "")
nyuukin(kensuu).hinichi = DateValue(hinichi)
namae = a(ii, 3)
namae = Replace(namae, " ", "")
namae = Replace(namae, "送金 ", "")
nyuukin(kensuu).namae = namae
kensuu = kensuu + 1
End If
Next
s = objIE.Document.body.innerhtml
If InStr(s, "value=次を表示 name=U070202") = 0 Then Exit Do
'On Error Resume Next
objIE.Document.all.U070202.Click ' button U070202 次を表示 or tags("INPUT").item(2).Click
' On Error GoTo 0
' If Err.Description <> "" Then
' Err.Clear
' Exit Do
'End If
Call ie_wait(objIE)
Loop
If kensuu < 0 Then
Application.StatusBar = "ログインでエラーが発生しました"
Else
If kensuu = 0 Then
Application.StatusBar = "新規受入はありません"
Else
Dim nyuukin_old As nyuukin_row
'最後の取り込みを探す
i = 2
nyuukin_old.hinichi = ""
nyuukin_old.kingaku = 0
nyuukin_old.namae = ""
Do Until Cells(i, 5).Value = "" '入金一覧サーチ
If Cells(i, 5).Value = "郵貯" Then
nyuukin_old.hinichi = Worksheets("入金").Cells(i, 2).Value
nyuukin_old.kingaku = Worksheets("入金").Cells(i, 3).Value
nyuukin_old.namae = Worksheets("入金").Cells(i, 4).Value
Exit Do
End If
i = i + 1
Loop
kaisi = 0
If nyuukin_old.kingaku > 0 Then
For i = 0 To kensuu - 1
If nyuukin_old.hinichi = nyuukin(i).hinichi And nyuukin_old.kingaku = nyuukin(i).kingaku And nyuukin_old.namae = nyuukin(i).namae Then
kaisi = i + 1
Exit For
End If
Next
Else '郵貯 初取り込み
End If
For i = kaisi To kensuu - 1
If nyuukin_old.hinichi = nyuukin(i).hinichi And nyuukin_old.kingaku = nyuukin(i).kingaku And nyuukin_old.namae = nyuukin(i).namae Then
Exit For
Else
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Selection.RowHeight = 13.5
Cells(2, 2).Value = nyuukin(i).hinichi
Cells(2, 4).Value = nyuukin(i).namae
Cells(2, 3).Value = nyuukin(i).kingaku
Cells(2, 5).Value = "郵貯"
End If
Next
'Rows("2:2").Select
Application.StatusBar = "郵貯より" & kensuu - kaisi & "件の入金を取り込みました"
End If
End If
お気に入りの記事を「いいね！」で応援しよう
Re:郵貯オンライン画面変わったexcel入金取り込み訂正(05/12)
ストロベリーランド
さん
ほんとなんてお礼をいったらいいか
いつもみてくれてありがとう
わたしこの前 リンクできないって言ったけど
ついのまえ ブックマークの
よく見るページとか いうのに
登録の仕方をおしえてもっらたから
アドレス預かっていきます
わたしも またブログっみせてもらいます～
勝手なことしてすいません
またみてください～
ありがと～
(2009.05.12 17:33:51)
いつもみてくれてありがとう
わたしこの前 リンクできないって言ったけど
ついのまえ ブックマークの
よく見るページとか いうのに
登録の仕方をおしえてもっらたから
アドレス預かっていきます
わたしも またブログっみせてもらいます～
勝手なことしてすいません
またみてください～
ありがと～
(2009.05.12 17:33:51)
Re:郵貯オンライン画面変わったexcel入金取り込み訂正(05/12)
*guinevere
さん
Re:郵貯オンライン画面変わったexcel入金取り込み訂正(05/12)
赤坂です。 さん
【毎日開催】
15記事にいいね！で1ポイント
© Rakuten Group, Inc.
