(VBA)エクセルデータをIEへ転記する方法について

【動作環境】
OS : windows10
ブラウザ : IE
IEバージョン : 11.1082.18362.0

【質問内容】
エクセルデータをIEで開いたページへ転記するVBAを作り、前までちゃんと転記できていたのに、急に転記されなくなりました。
ウィンドウが見つからない場合に動作する「入力するページが見つかりません」が表示されてしまいます。
サイトのURLも一致しているのですが、なぜできなくなってしまったのかがわかりません。
アドバイス頂けないでしょうか？

VBA
1Sub ie_test2()
2
3    Dim colSh As Object
4    Dim win As Object
5    Dim objIE As Object
6    Set colSh = CreateObject("Shell.Application")
7    
8    '開いているすべてのウインドウに対して処理する
9    For Each win In colSh.Windows
10    
11        '開いているファイルの種類がHTMLなら処理を実行する
12        If TypeName(win.document) = "HTMLDocument" Then
13        
14        '開いているサイトのURLが下記だったら
15        If win.document.Url = "https://www.shopjapan.co.jp/shop/customer/entry" Then
16        
17        '開いているファイルの「タイトル」にYahooが含まれているなら
18        'If InStr(win.document.Title, "ショップジャパン") > 0 Then
19        
20        'このウインドウをobjIEとして指定する
21        Set objIE = win
22        
23        objIE.document.getElementsByName("postCd")(0).Value = Range("D2").Value
24        objIE.document.getElementsByName("address1")(0).Value = Range("E2").Value
25        objIE.document.getElementsByName("address2")(0).Value = Range("F2").Value
26        objIE.document.getElementsByName("address3")(0).Value = Range("G2").Value
27
28
29
30        End If
31        
32        End If
33        
34
35    '処理を中断してFor~Nextを終了する
36    Exit For
37    
38    Next
39    
40    'ウインドウが見つからなければ
41    If objIE Is Nothing Then
42    
43        'メッセージを表示して
44         MsgBox "入力するページが見つかりません"
45    
46        '処理を終了する
47        Exit Sub
48    
49    End If
50    
51    Range("A2").Interior.Color = RGB(255, 0, 0)
52   
53End Sub

以上になります。
宜しくお願い致します。

【補足】
ちゃんと転記できるときと、できないときがあります。
原因は不明です。

行動規範の内容に同意します

回答1件

ベストアンサー

URL一致判定を以下の通り修正してみてください。

VBA
1If win.LocationURL = "https://www.shopjapan.co.jp/shop/customer/entry" Then
2'If win.document.Url = "https://www.shopjapan.co.jp/shop/customer/entry" Then

追記
Exit For の位置を変更してみました。

VBA
1'開いているすべてのウインドウに対して処理する
2For Each win In colSh.Windows
3
4    On Error Resume Next 'Window取得エラー対策
5    '開いているファイルの種類がHTMLなら処理を実行する
6    If TypeName(win.document) <> "HTMLDocument" Then
7    Else
8        '開いているサイトのURLが下記だったら
9        If win.LocationURL = "https://www.shopjapan.co.jp/shop/customer/entry" Then
10        'If win.document.Url = "https://www.shopjapan.co.jp/shop/customer/entry" Then
11    
12            'このウインドウをobjIEとして指定する
13            Set objIE = win
14    
15            objIE.document.getElementsByName("postCd")(0).Value = Range("D2").Value
16            objIE.document.getElementsByName("address1")(0).Value = Range("E2").Value
17            objIE.document.getElementsByName("address2")(0).Value = Range("F2").Value
18            objIE.document.getElementsByName("address3")(0).Value = Range("G2").Value
19            
20            '処理を中断してFor~Nextを終了する
21            Exit For
22        End If
23    End If
24    On Error GoTo 0
25Next