212279 ランダム
 ホーム | 日記 | プロフィール 【フォローする】 【ログイン】

EXCEL VBA TIPS

EXCEL VBA TIPS

【毎日開催】
15記事にいいね!で1ポイント
10秒滞在
いいね! --/--
おめでとうございます!
ミッションを達成しました。
※「ポイントを獲得する」ボタンを押すと広告が表示されます。
x

PR

キーワードサーチ

▼キーワード検索

プロフィール

EXCEL VBA TIPS

EXCEL VBA TIPS

楽天カード

カレンダー

お気に入りブログ

バンの日記 バン3105さん
Leno★ROOM レノママ♪さん
RS うけぽの独り言 うけぽさん
LAHAINA’s … lahaina13さん
ウサといっ緒 今日… チェシゃ猫さん

コメント新着

RaymondArout@ Безопасность Впервые с начала противостояния в украи…
RaymondArout@ Сенаторы Впервые с начала противостояния в украи…
RaymondArout@ Санкции Впервые с начала операции в украинский …
Harveytoogs@ сериалы онлайн сезон Элита сериалы он-лайн шара в течение пр…
RaymondArout@ Демократы Впервые с начала спецоперации в украинс…

フリーページ

ニューストピックス

2009.05.12
XML
カテゴリ:カテゴリ未分類
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 'IEオブジェクト参照用

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"
Call ie_wait(objIE)
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.shoukaiHaniSentaku(0).Checked = True ' radio 日付指定
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)
For ii = 1 To 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





お気に入りの記事を「いいね!」で応援しよう

最終更新日  2009.05.12 14:06:49
コメント(3) | コメントを書く



© Rakuten Group, Inc.
X