質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.98%

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

受付中

回答 2

投稿

  • 評価
  • クリップ 1
  • VIEW 1,835

toshikii

score 4

前提・実現したいこと

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

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

エラーメッセージ なし

該当のソースコード

#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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

0

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

With CreateObject("Wscript.Shell")
  '「Ctrl」+「v」を送信
  .SendKeys "^v", True

  DoEvents: Sleep 500: DoEvents

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/12/22 23:37 編集

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

    キャンセル

0

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.98%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる