同じ名前のページは1枚だけ開いていてほしい

Question

### 前提・実現したいこと ExcelのシートのA列に伝票番号が列挙されています。この伝票番号を、社内Webの伝票番号を登録するページに登録させるマクロを書きました。 IEで登録ページはもう開いておいて、そのページを見つけて捕まえて、順に伝票番号を入力して登録するような手順です。 IEのページを見つけるのは三流君とかの記事を見て学びました。登録ページは、1件ずつ伝票番号をテキストボックスに入力して、登録ボタンを押すようになっています。 ```VBA Dim sh As Object '起動中のShellWindow一式を格納する Dim win As Object '各ShellWindowを格納する Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する Dim document_title As String 'IEのドキュメントタイトルを格納する Dim inputbutton As HTMLAnchorElement 'ボタンとかを探すときに要素を格納する Dim i As Long 'イテレータ Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行 '*-- 起動中のShellWindow一式を変数shに格納 --* Set sh = CreateObject("Shell.Application") For Each win In sh.Windows 'ドキュメントタイトル取得失敗を無視（処理継続）--* On Error Resume Next If TypeName(win.document) = "HTMLDocument" Then document_title = "" document_title = win.document.Title On Error GoTo 0 '*-- ページのタイトルで探す --* Set ie = win If InStr(document_title, "伝票番号入力") > 0 Then '*-- シートの伝票番号の数だけ繰り返す --* For i = 1 To endRow Step 1 '*-- 伝票番号を入れて登録ボタンを押す --* ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value For Each inputbutton In ie.document.getElementsByTagName("input") If inputbutton.Value = "登録" Then inputbutton.Click Exit For End If Next Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE DoEvents Loop Next i Exit For Else '*-- 画面を閉じる(登録画面以外のIE) --* ie.Quit End If End If Next '*-- いろいろ解放 --* Set sh = Nothing Set ie = Nothing ``` ### 発生している問題・エラーメッセージバカみたいにいっぱいIEを立ち上げてる人がいて（ウィンドウを開いたら開きっぱなしで閉じないスタイル）なので伝票登録のこれ動作時に、同じ名前のウィンドウが複数開いていると、目的のと違うウィンドウを捕まえてしまうことが多く…… なので、これを動かす前に、この伝票番号入力ページが複数開いていたら「開いてますよ！」と怒ったうえでこれの処理はしない、というようにしたいのですが複数開いています、というのをどうやったらいいのか思いつきません。「起動中のShellWindow一式を変数shに格納」の後に ```VBA cntPage = 0 For Each win In sh.Windows 'ドキュメントタイトル取得失敗を無視（処理継続）--* On Error Resume Next If TypeName(win.document) = "HTMLDocument" Then document_title = "" document_title = win.document.Title On Error GoTo 0 '*-- ページのタイトルを数える --* Set ie = win If InStr(document_title, "伝票番号入力") > 0 Then cntPage=cntPage + 1 End If End If Next If cntPage <> 1 then MsgBox "IEは目的の1枚だけ開いておいてあとは閉じてください" Exit Sub End If ``` みたいなのを書けばよいのでしょうか。同じようなコードが2回来るのってみっともなくないでしょうか。 ### 補足情報（FW/ツールのバージョンなど） Win10、Excel2016、IE11です。 ###追加1 皆様ありがとうございます！教えていただいた内容を踏まえて、関数にしてみました。 ```VBA Sub entryDenpyo() Dim sh As Object '起動中のShellWindow一式を格納する Dim win As New Collection '各ShellWindowを格納する Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する Dim document_title As String 'IEのドキュメントタイトルを格納する Dim inputbutton As HTMLAnchorElement 'ボタンとかを探すときに要素を格納する Dim i As Long 'イテレータ Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行 '*-- 起動中のShellWindow一式を変数shに格納 --* Set sh = CreateObject("Shell.Application") '*-- IEで開かれている[伝票番号入力]ページを探す、1個だけ開かれてるんじゃなかったら処理はしない。 --* Set win = FindPages(sh,"伝票番号入力") If win.Count = 1 Then Set ie = win(1) Else MsgBox ("伝票番号入力画面を1個だけ開いて、あとは閉じてください。") Exit Sub End If '*-- シートの伝票番号の数だけ繰り返す --* For i = 1 To endRow Step 1 '*-- 伝票番号を入れて登録ボタンを押す --* ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value For Each inputbutton In ie.document.getElementsByTagName("input") If inputbutton.Value = "登録" Then inputbutton.Click Exit For End If Next Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE DoEvents Loop Next i '*-- いろいろ解放 --* Set sh = Nothing Set ie = Nothing End Sub '*-- 開いているIEのページをcollectionに入れて戻す --* Function FindPages(ByVal shs As Object,ByVal pagetitle as string) As Collection Dim win As Object '各ShellWindowを格納する Dim document_title As String 'IEのドキュメントタイトルを格納する Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する Dim clIE As New Collection 'コレクション格納用 For Each win In shs.Windows 'ドキュメントタイトル取得失敗を無視（処理継続）--* On Error Resume Next If TypeName(win.document) = "HTMLDocument" Then document_title = "" document_title = win.document.Title On Error GoTo 0 '*-- タイトルで探す --* Set ie = win If InStr(document_title, pagetitle) > 0 Then clIE.Add ie '合致したページをコレクションに格納 Set FindPages = clIE End If End If Next End Function ``` ここまで書いてから、h.horikoshiさんの回答を見て「目的のページ1枚だけを戻すほうがいいっぽい…」ということに気づきましたので、もういっかい考えます。 ###追加2(できた！) ```VBA Sub entryDenpyo() Dim sh As Object '起動中のShellWindow一式を格納する Dim ie As InternetExplorer 'FindPages関数で見つけたIEを格納する Dim inputbutton As HTMLAnchorElement 'ボタンとかを探すときに要素を格納する Dim i As Long 'イテレータ Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行 '*-- 起動中のShellWindow一式を変数shに格納 --* Set sh = CreateObject("Shell.Application") '*-- IEで開かれている[伝票番号入力]ページを探す、1個だけ開かれてるんじゃなかったら処理はしない。 --* Set ie = FindPages(sh,"伝票番号入力") If (Not (ie Is Nothing)) Then '*-- シートの伝票番号の数だけ繰り返す --* For i = 1 To endRow Step 1 '*-- 伝票番号を入れて登録ボタンを押す --* ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value For Each inputbutton In ie.document.getElementsByTagName("input") If inputbutton.Value = "登録" Then inputbutton.Click Exit For End If Next Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE DoEvents Loop Next i else MsgBox "登録画面がみつかりません！" End If '*-- いろいろ解放 --* Set sh = Nothing Set ie = Nothing MsgBox "おわりました" End Sub '*-- 開いているIEのページを目的の1個だけ戻す。ページがなかったり複数だったりしたらNothingを戻す。 --* Function FindPages(ByVal shs As Object, ByVal pagetitle As String) As InternetExplorer Dim win As Object '各ShellWindowを格納する Dim document_title As String 'IEのドキュメントタイトルを格納する Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する Set FindPages = Nothing For Each win In shs.Windows 'ドキュメントタイトル取得失敗を無視（処理継続）--* On Error Resume Next If TypeName(win.document) = "HTMLDocument" Then document_title = "" document_title = win.document.Title On Error GoTo 0 '*-- IEだったらタイトルで探す --* Set ie = win If InStr(document_title, pagetitle) > 0 Then If FindPages Is Nothing Then Set FindPages = ie Else MsgBox pagetitle & ("画面を1個だけ開いて、あとは閉じてください。") Set FindPages = Nothing Exit Function End If End If End If Next End Function ``` 皆様のご指導のもとに、とても改善して書けました！「開いているIEのページを目的の1個だけ戻す」というのは他にも1件ずつエントリするような作業がいろいろありますので（社内システムがイケてないので……）この部分を関数にできたので、使いまわせそうな気がします。ベストアンサーっていっぱいつけられないのですね…… teratailは先生がいっぱいいるので嬉しいです！ありがとうございます。

Accepted Answer

現状ではWindow検索ループ（外側ループ）の中で目的のWindowを探し、見つけたその場で登録処理のループを行っていると思います。
```
①Window検索ループ
②　Windowタイトル判定
③　⇒合致していたら登録処理（登録用の内側ループ）
④Loop　Next
```

ここにそのまま全Windowタイトルのチェックを追加しようと考えると
＞同じようなコードが2回来るのってみっともなくないでしょうか。
となってしまうと思います。

他の回答者さんからも指摘が出ているとおり、同じ処理を複数回行う必要があるのなら関数化してしまった方が機能的です。

しかし今回の場合、Window検索ループは「対象となる１Windowを見つける」ことが目的のループ処理です。
見つけたWindowに片っ端から登録処理をしたいわけではありませんので、このループ内で登録処理まで行う必要はありません。
目的のWindowさえ特定できていれば、登録はループを抜けた後でもかまわないのです。

Window検索ループはあくまで目的のWindowを見つけるためのループ処理にとどめ、対象のWindowを見つけた際には即登録ではなくオブジェクト変数に格納しておくようにします。
全てのWindowを検索し終えた後、対象が１ページだけ見つかっていた場合には、オブジェクト変数に格納しておいたページに対して登録処理を行えば無駄なコーディングが避けられると思います。
```
①Window検索ループ
②　Windowタイトル判定
③　⇒見つけたページをオブジェクト変数に格納する
③　⇒２つ目の対象Windowが見つかったタイミングでメッセージ表示＆処理中断
④Loop　Next
⑤見つけたページがあれば登録処理（複数見つけた場合はこの処理までこない）
```

参考になれば幸いです。

Answer

>同じようなコードが2回来るのってみっともなくないでしょうか

関数を作ってしまいましょう。
関数の中で多重チェックとIEウィンドウの取り出しを同時にやれば
すっきりすると思います。

```VBA
Public Function getIEWindow(ByVal title As String) As Object
'==============================================================================
'■getIEWindow : 開いているIEのウィンドウを返す。取得に失敗または複数起動の場合
'はNothingを返す。複数起動の場合はメッセージが出る。
'==============================================================================
  Set getIEWindow = Nothing
  
On Error Resume Next
  Dim sh As Object: Set sh = CreateObject("Shell.Application")
  Dim win As Object
  For Each win In sh.Windows
    If (TypeName(win.document) = "HTMLDocument") Then
      If (InStr(win.document.title, title) > 0) Then
        If (getIEWindow Is Nothing) Then                                    ' 初出の検出
          Set getIEWindow = win
        Else                                                                ' 複数検出
          MsgBox "IEは目的の1枚だけ開いておいてあとは閉じてください"
          Set getIEWindow = Nothing
          Exit Function
        End If
      End If
    End If
  Next
  Set win = Nothing
  Set sh = Nothing
On Error GoTo 0

End Function
```


呼び出し元
```
Dim ie As Object: Set ie = getIEWindow("伝票番号入力")
If (Not (ie Is Nothing)) Then ...
```

Answer

> IEで登録ページはもう開いておいて、そのページを見つけて捕まえて、順に伝票番号を入力して登録するような手順です。

この、「IEで登録ページはもう開いておいて」の部分は、具体的にどういうことなのでしょう。
ユーザーが手作業で開くのでしょうか。それともVBAの別の処理で開くということでしょうか。

VBAでの自動登録ということなら、CreateObjectでIEを新規に開いて、そのIEで登録ページを開いて登録処理をすれば、既存のIEがどのページを開いていようが、関係ないと思いますが、そうできない理由はなんでしょうか。

追記
---

条件に合致するページが１枚だけのときに、処理を実行するということなら、
合致するページをコレクションに格納して、その件数で処理を分けたらどうでしょう。
（動的配列かDictionalyオブジェクトに格納する方法もありますが今回はコレクションで。）

```vba
    Dim win As Object               '各ShellWindowを格納する
    Dim ie As InternetExplorer 
    Dim clIE As New Collection

    '*-- 起動中のShellWindow一式を変数shに格納 --*
    Set sh = CreateObject("Shell.Application")

    For Each win In sh.Windows
        'ドキュメントタイトル取得失敗を無視（処理継続）--*
        On Error Resume Next

        If TypeName(win.document) = "HTMLDocument" Then
            document_title = ""
            document_title = win.document.Title
            On Error GoTo 0
            '*-- ページのタイトルで探す --*
            Set ie = win
            If InStr(document_title, "伝票番号入力") > 0 Then
                clIE.Add IE '合致したページをコレクションに格納
            Else
                '*-- 画面を閉じる(登録画面以外のIE) --*
                ie.Quit
            End If
        End If
    Next

	Select Case clIE.Count
	Case 0
	    MsgBox "登録ページを開いてください。"
	Case 1
	    Set IE = clIE(1)
	    '登録処理
	Case Else
	    MsgBox "IEは目的の1枚だけ開いておいてあとは閉じてください"
            'ここでコレクション内のページを閉じる処理をいれるのもあり
	End Select
```

Answer

ループ内に処理を突っ込んでいますが、このような時にはループを外に出しましょう。

まず目的のページを見つけるためだけの関数を作ります。
この関数を仮に FindPages と名付けます。
その中ではまず空の配列を作り、次いでループを使って見つかったページを配列に追加します。
ループ終了したら作った配列を戻り値として返します。

呼び出し側はまず FindPages を呼び出して配列を取得します。
その配列の要素数が 0 であったらページが開かれていないのでエラー処理をします。
2 以上なら複数開かれているのでエラー処理をします。
1 なら該当ページは一つだけ開かれているので、そのページに対して処理をします。

Answer

オペレーション的には、最初にIEが開いているかチェックして、1枚でも開いていたら「閉じます」のメッセージの後すべて自動的に閉じてから処理を開始するほうがわかりやすいような気がします。
できるのかはわかりませんが、とりあえず仕様的観点からの回答でした。

前提・実現したいこと

発生している問題・エラーメッセージ

補足情報（FW/ツールのバージョンなど）

追記

関連した質問