前提・実現したいこと
ExcelのシートのA列に伝票番号が列挙されています。
この伝票番号を、社内Webの伝票番号を登録するページに登録させるマクロを書きました。
IEで登録ページはもう開いておいて、そのページを見つけて捕まえて、順に伝票番号を入力して登録するような手順です。
IEのページを見つけるのは三流君とかの記事を見て学びました。
登録ページは、1件ずつ伝票番号をテキストボックスに入力して、登録ボタンを押すようになっています。
VBA
1 Dim sh As Object '起動中のShellWindow一式を格納する 2 Dim win As Object '各ShellWindowを格納する 3 Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する 4 Dim document_title As String 'IEのドキュメントタイトルを格納する 5 Dim inputbutton As HTMLAnchorElement 'ボタンとかを探すときに要素を格納する 6 Dim i As Long 'イテレータ 7 Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行 8 9 10 '*-- 起動中のShellWindow一式を変数shに格納 --* 11 Set sh = CreateObject("Shell.Application") 12 13 For Each win In sh.Windows 14 'ドキュメントタイトル取得失敗を無視(処理継続)--* 15 On Error Resume Next 16 17 If TypeName(win.document) = "HTMLDocument" Then 18 document_title = "" 19 document_title = win.document.Title 20 On Error GoTo 0 21 22 '*-- ページのタイトルで探す --* 23 Set ie = win 24 If InStr(document_title, "伝票番号入力") > 0 Then 25 26 '*-- シートの伝票番号の数だけ繰り返す --* 27 For i = 1 To endRow Step 1 28 '*-- 伝票番号を入れて登録ボタンを押す --* 29 ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value 30 For Each inputbutton In ie.document.getElementsByTagName("input") 31 If inputbutton.Value = "登録" Then 32 inputbutton.Click 33 Exit For 34 End If 35 Next 36 Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE 37 DoEvents 38 Loop 39 Next i 40 Exit For 41 Else 42 '*-- 画面を閉じる(登録画面以外のIE) --* 43 ie.Quit 44 End If 45 End If 46 Next 47 48 '*-- いろいろ解放 --* 49 Set sh = Nothing 50 Set ie = Nothing
発生している問題・エラーメッセージ
バカみたいにいっぱいIEを立ち上げてる人がいて(ウィンドウを開いたら開きっぱなしで閉じないスタイル)
なので伝票登録のこれ動作時に、同じ名前のウィンドウが複数開いていると、目的のと違うウィンドウを捕まえてしまうことが多く……
なので、これを動かす前に、この伝票番号入力ページが複数開いていたら
「開いてますよ!」と怒ったうえでこれの処理はしない、というようにしたいのですが
複数開いています、というのをどうやったらいいのか思いつきません。
「起動中のShellWindow一式を変数shに格納」の後に
VBA
1 cntPage = 0 2 For Each win In sh.Windows 3 'ドキュメントタイトル取得失敗を無視(処理継続)--* 4 On Error Resume Next 5 6 If TypeName(win.document) = "HTMLDocument" Then 7 document_title = "" 8 document_title = win.document.Title 9 On Error GoTo 0 10 11 '*-- ページのタイトルを数える --* 12 Set ie = win 13 If InStr(document_title, "伝票番号入力") > 0 Then 14 cntPage=cntPage + 1 15 End If 16 End If 17 Next 18 If cntPage <> 1 then 19 MsgBox "IEは目的の1枚だけ開いておいてあとは閉じてください" 20 Exit Sub 21 End If
みたいなのを書けばよいのでしょうか。
同じようなコードが2回来るのってみっともなくないでしょうか。
補足情報(FW/ツールのバージョンなど)
Win10、Excel2016、IE11です。
###追加1
皆様ありがとうございます!
教えていただいた内容を踏まえて、関数にしてみました。
VBA
1Sub entryDenpyo() 2 3 Dim sh As Object '起動中のShellWindow一式を格納する 4 Dim win As New Collection '各ShellWindowを格納する 5 Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する 6 Dim document_title As String 'IEのドキュメントタイトルを格納する 7 Dim inputbutton As HTMLAnchorElement 'ボタンとかを探すときに要素を格納する 8 Dim i As Long 'イテレータ 9 Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行 10 11 12 '*-- 起動中のShellWindow一式を変数shに格納 --* 13 Set sh = CreateObject("Shell.Application") 14 15 '*-- IEで開かれている[伝票番号入力]ページを探す、1個だけ開かれてるんじゃなかったら処理はしない。 --* 16 Set win = FindPages(sh,"伝票番号入力") 17 If win.Count = 1 Then 18 Set ie = win(1) 19 Else 20 MsgBox ("伝票番号入力画面を1個だけ開いて、あとは閉じてください。") 21 Exit Sub 22 End If 23 24 '*-- シートの伝票番号の数だけ繰り返す --* 25 For i = 1 To endRow Step 1 26 '*-- 伝票番号を入れて登録ボタンを押す --* 27 ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value 28 For Each inputbutton In ie.document.getElementsByTagName("input") 29 If inputbutton.Value = "登録" Then 30 inputbutton.Click 31 Exit For 32 End If 33 Next 34 Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE 35 DoEvents 36 Loop 37 Next i 38 39 '*-- いろいろ解放 --* 40 Set sh = Nothing 41 Set ie = Nothing 42 43End Sub 44 45'*-- 開いているIEのページをcollectionに入れて戻す --* 46Function FindPages(ByVal shs As Object,ByVal pagetitle as string) As Collection 47 48 Dim win As Object '各ShellWindowを格納する 49 Dim document_title As String 'IEのドキュメントタイトルを格納する 50 Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する 51 Dim clIE As New Collection 'コレクション格納用 52 53 For Each win In shs.Windows 54 'ドキュメントタイトル取得失敗を無視(処理継続)--* 55 On Error Resume Next 56 57 If TypeName(win.document) = "HTMLDocument" Then 58 document_title = "" 59 document_title = win.document.Title 60 On Error GoTo 0 61 62 '*-- タイトルで探す --* 63 Set ie = win 64 If InStr(document_title, pagetitle) > 0 Then 65 clIE.Add ie '合致したページをコレクションに格納 66 Set FindPages = clIE 67 End If 68 End If 69 Next 70 71End Function
ここまで書いてから、h.horikoshiさんの回答を見て
「目的のページ1枚だけを戻すほうがいいっぽい…」
ということに気づきましたので、もういっかい考えます。
###追加2(できた!)
VBA
1Sub entryDenpyo() 2 3 Dim sh As Object '起動中のShellWindow一式を格納する 4 Dim ie As InternetExplorer 'FindPages関数で見つけたIEを格納する 5 Dim inputbutton As HTMLAnchorElement 'ボタンとかを探すときに要素を格納する 6 Dim i As Long 'イテレータ 7 Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行 8 9 10 '*-- 起動中のShellWindow一式を変数shに格納 --* 11 Set sh = CreateObject("Shell.Application") 12 13 '*-- IEで開かれている[伝票番号入力]ページを探す、1個だけ開かれてるんじゃなかったら処理はしない。 --* 14 Set ie = FindPages(sh,"伝票番号入力") 15 16 If (Not (ie Is Nothing)) Then 17 '*-- シートの伝票番号の数だけ繰り返す --* 18 For i = 1 To endRow Step 1 19 '*-- 伝票番号を入れて登録ボタンを押す --* 20 ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value 21 For Each inputbutton In ie.document.getElementsByTagName("input") 22 If inputbutton.Value = "登録" Then 23 inputbutton.Click 24 Exit For 25 End If 26 Next 27 Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE 28 DoEvents 29 Loop 30 Next i 31 else 32 MsgBox "登録画面がみつかりません!" 33 End If 34 35 '*-- いろいろ解放 --* 36 Set sh = Nothing 37 Set ie = Nothing 38 MsgBox "おわりました" 39 40End Sub 41 42'*-- 開いているIEのページを目的の1個だけ戻す。ページがなかったり複数だったりしたらNothingを戻す。 --* 43Function FindPages(ByVal shs As Object, ByVal pagetitle As String) As InternetExplorer 44 45 Dim win As Object '各ShellWindowを格納する 46 Dim document_title As String 'IEのドキュメントタイトルを格納する 47 Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する 48 49 Set FindPages = Nothing 50 For Each win In shs.Windows 51 'ドキュメントタイトル取得失敗を無視(処理継続)--* 52 On Error Resume Next 53 54 If TypeName(win.document) = "HTMLDocument" Then 55 document_title = "" 56 document_title = win.document.Title 57 On Error GoTo 0 58 59 '*-- IEだったらタイトルで探す --* 60 Set ie = win 61 If InStr(document_title, pagetitle) > 0 Then 62 If FindPages Is Nothing Then 63 Set FindPages = ie 64 Else 65 MsgBox pagetitle & ("画面を1個だけ開いて、あとは閉じてください。") 66 Set FindPages = Nothing 67 Exit Function 68 End If 69 End If 70 End If 71 Next 72 73End Function
皆様のご指導のもとに、とても改善して書けました!
「開いているIEのページを目的の1個だけ戻す」というのは
他にも1件ずつエントリするような作業がいろいろありますので(社内システムがイケてないので……)
この部分を関数にできたので、使いまわせそうな気がします。
ベストアンサーっていっぱいつけられないのですね……
teratailは先生がいっぱいいるので嬉しいです!ありがとうございます。
回答5件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/03/27 07:28
2018/03/29 00:30