VBA IE制御でファイル選択ダイアログにファイルパス入力

Question

前提・実現したいこと

VBA IE制御でファイル選択ダイアログにファイルパス入力したいのですが、ファイル選択ダイアログを表示させるところまではできるのですがファイル選択ダイアログを開いてからエラーもでることなく処理が止まってしまいます。
1.VBAからIEでページを開く
2.クリックボードに画像パスをコピー
3.画像選択ダイアログボックスを開くために、所定の箇所をクリック
4：開いたダイアログボックスにSendkeys でCtrl+v してクリックボードから画像パスを入力
5：SendKeys "%o", でファイル選択ダイアログの開くをクリック
6：処理終了
3までは動きますが3の処理から止まってしまいます。
４以降の処理ができません。

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

エラーメッセージ　なし

該当のソースコード

#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

Sub otamart()
Dim objIE As InternetExplorer 'IEオブジェクトを準備
Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット
Dim CB As New DataObject
    
objIE.Visible = True 'IEを表示

Dim gazou As String
gazou = "画像パス"
 
Dim strUrl As String '次ページのURL
strUrl = "https://webapp.otamart.com/sell"
 
With CB 'クリックボードにコピー
    .SetText gazou
    .PutInClipboard
End With
 
objIE.navigate strUrl 'IEでURLを開く

Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち
 
    DoEvents
 
Loop
Sleep (3000)

objIE.document.getElementsByName("picture00")(0).Click
Sleep (1000)
SendKeys "^v", True
SendKeys "%o", True

End Sub

試したこと

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

windows10 Excel 2013

Answer 1

VBAのSendkeyメソッドは安定しないので、あまり使わない方がいいです。
ここは、発想を転換し、指定のurlの画像を一気に保存していまう方法にしてはどうでしょうか？
パソコンに保存してしまえば、その後は、自由自在に扱えると思います。
Windows APIを多用してしまいますが、悪くない方法だと思います。

Option Explicit

Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal pCaller As LongPtr, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As LongPtr, _
    ByVal lpfnCB As LongPtr) As LongPtr

Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet" _
    Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As LongPtr

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)


Sub ieCheck(objIE As InternetExplorer)
    Dim timeOut As Date
    
    '完全にページが表示されるまで待機する
    timeOut = Now + TimeSerial(0, 0, 20)
    
    Do While objIE.Busy = True Or objIE.readyState <> 4
        DoEvents
        Sleep 1
        If Now > timeOut Then
            objIE.Refresh
            timeOut = Now + TimeSerial(0, 0, 20)
        End If
    Loop
    
    timeOut = Now + TimeSerial(0, 0, 20)
    
    Do While objIE.document.readyState <> "complete"
        DoEvents
        Sleep 1
        If Now > timeOut Then
            objIE.Refresh
            timeOut = Now + TimeSerial(0, 0, 20)
        End If
   Loop
    
End Sub

Sub ieView(objIE As InternetExplorer, _
           urlName As String, _
           Optional viewFlg As Boolean = True, _
           Optional ieTop As Integer = 0, _
           Optional ieLeft As Integer = 0, _
           Optional ieWidth As Integer = 600, _
           Optional ieHeight As Integer = 800)
    
    'IE(InternetExplorer)のオブジェクトを作成する
    Set objIE = CreateObject("InternetExplorer.Application")
    
    With objIE
        
        'IE(InternetExplorer)を表示・非表示
        .Visible = viewFlg
        
        .Top = ieTop  'Y位置
        .Left = ieLeft  'X位置
        .Width = ieWidth  '幅
        .Height = ieHeight  '高さ
        
        '指定したURLのページを表示する
        .navigate urlName
    
    End With
    
    'IE(InternetExplorer)が完全表示されるまで待機
    Call ieCheck(objIE)
    
End Sub



Sub sample01()

    Dim objIE  As InternetExplorer
    Dim imgURL As String, fileName As String, savePath As String
    Dim cacheDel As LongPtr, result As LongPtr
    Dim i As Long
    Dim strFolderText As String
    Dim sw As Object, myPath As Object
    
    
    Set sw = CreateObject("Shell.Application")
    Set myPath = sw.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\")
    If Not myPath Is Nothing Then
        strFolderText = myPath.Items.Item.Path
    Else
        Set sw = Nothing
        Set myPath = Nothing
        Exit Sub
    End If
    Set sw = Nothing
    Set myPath = Nothing
    
    
    Call ieView(objIE, "https://transit.yahoo.co.jp/", False, 300, 300, 1800, 1200)
    
    
    For i = 1 To objIE.document.images.Length
        
        '画像URL取得
        imgURL = objIE.document.images(i - 1).src
        
        '画像ファイル名
        fileName = Mid(imgURL, InStrRev(imgURL, "/") + 1)
        
        '画像保存先(+画像ファイル名）
        savePath = strFolderText & "\" & fileName
        Debug.Print savePath
        
        'キャッシュクリア
        cacheDel = DeleteUrlCacheEntry(imgURL)
        
        '画像ダウンロード
        result = URLDownloadToFile(0, imgURL, savePath, 0, 0)
        
    Next i
    
    objIE.Quit
    
    MsgBox "画像を指定のフォルダにダウンロードしました。"
    
End Sub

Answer 2

SendKeysが不安定な場合、Wscript.Shell を使うほうがよいです。

With CreateObject("Wscript.Shell")
  '「Ctrl」＋「v」を送信
  .SendKeys "^v", True
           
  DoEvents: Sleep 500: DoEvents

  '「Alt」＋「o」を送信
  .SendKeys "%o", True
End With

Comments

[TanakaHiroaki]

難易度が高いですが、Win APIを使用する別解もあります。
ファイル選択ダイアログのウィンドウハンドルを取得し、
”SendMessage”で操作するとアクティブウィンドウ以外に
メッセージを送ることが出来るので確実です。
http://rabbitfoot.xyz/file-dialog-autmation/