VBAによるエクスプローラによるアップロードファイルの選択ができない

Question

何をしたいか
VBAの勉強がし終わったのでスクレイピングなどの勉強のためにVBAによるラクマの自動出品システムを作りたいと思っています。

問題点
ラクマへのログインの後に出品ページに移動して、その際に写真を追加したいのですが、写真をアップロードするところまではいったのですがそのあとの自分で写真を選択するところが全くできていないようです。

コードの紹介
以下のコードが現在書いているものになります。コメントアウトをしてどんな動作を期待しているのかを記載しています。
また、コードを書いていくうえで参考にさせていただいているurl:https://rabbitfoot.xyz/file-dialog-autmation/

'---------------------APIの宣言-----------------------------------------
Private Declare Function FindWindowEx Lib "user32.dll" _
    Alias "FindWindowExA" ( _
    ByVal hWndParent As Long, _
    ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, _
    ByVal lpszWindow As String) As Long

Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal Msg As Long, _
        ByVal wParam As Long, ByVal lParam As Any) As Long

'-------------------処理部分----------------------------------------------
Dim photo As HTMLInputElemnt
Set photo=objIE.document.getElementByName("image_tmp")(1)  'あくまで現在は２つ目の部分をクリックするようにしている
photo.Click  'ここまでは動作する　アップロードする前まで行く

'以下を記入した際にはファイルを自分でアップロードをしたりするまで動かない
　Dim hInputBox As Long
　Dim hButton As Long
　Dim hWindow As Long

　hWindow = FindWindow("#32770", "アップロードするファイルの選択")

　hInputBox = FindWindowEx(hWindow, 0&, "ComboBoxEx32", "")
　hInputBox = FindWindowEx(hInputBox, 0&, "ComboBox", "")
　hInputBox = FindWindowEx(hInputBox, 0&, "Edit", "")
　hButton = FindWindowEx(hWindow, 0&, "Button", "開く(&O)")

'ファイルパス入力'
Call SendMessage(hInputBox, &HC, 0, "C:\test.jpg") 'きちんと絶対パスを通しておいてもクリックなどされない

'ボタン押下'
Call SendMessage(hButton, &H6, 1, 0&)  'ボタンをアクティブにする
Call SendMessage(hButton, &HF5, 0, 0&) 'ボタンをクリックする

やったこと
何時間も悩んでmsgboxを使って途中の出力を見てみたのですが、やはりファイルをクリックしたりする処理自体ができておらず、開いたファイルを閉じた後に実行されてしまいます。
また、shellなども使ってみましたが見当違いだと思います。

何かアドバイスいただけると幸いです。よろしくお願いいたします。

Answer 1

photo.Clickによるクリックイベントでダイアログが開いているため、VBA側もクリックイベント終了待ちで待機しているのが原因でしょう。

クリックをするところか、画面操作部分のどちらかを別に動作させればいいはずです。

比較的簡単に別に動作させる方法としては、外部プロセスで上記処理を行うことです。
例えばVBScriptやPowerShellであれば、IEの操作ができますし、PowerShellなら画面操作も可能です。

以下は、VBScriptでIEを操作する処理のサンプルです。

'任意の場所に`~.vbs`という名前でテキストファイルを作成し、以下のコードを記述して保存しておく。
'文字のエンコーディングはShift_JISまたはUnicode(UTF16LE)であること。
'https://teratail.com/questions/253981

Option Explicit

'`/HWND:「何か」`で指定したコマンドライン引数を取得。
Dim ieHwnd 'As LongPtr
ieHwnd = CDbl(WSH.Arguments.Named("HWND")) 'CLngPtrが無いのでむりやり。

'HWNDを使ってIEを取得(ウィンドウでタブを複数開いている場合には、追加条件が欲しいかも)。
Dim objIE 'As SHDocVw.InternetExplorer
Set objIE = FindIEByHwnd(ieHwnd)

If objIE Is Nothing Then
    MsgBox "HWND:" & ieHwnd & vbLf & "のIEのウィンドウが見つかりませんでした。"
    WSH.Quit
End If

'以下任意の処理。
MsgBox objIE.Document.Title



'FindIEByHwnd
    'HWNDをベースにIEのウィンドウを探して返す。
    '必要に応じてURLなどの条件を追加した方が良いかも？

'inHwnd As LongPtr
Public Function FindIEByHwnd(inHwnd) 'As SHDocVw.WebBrowser
    
    Dim appShell 'As Shell32.Shell
    Set appShell = CreateObject("Shell.Application")
    
    Dim w 'As SHDocVw.WebBrowser
    For Each w In appShell.Windows()
        If w.Hwnd = inHwnd Then
            Set FindIEByHwnd = w
            Exit Function
        End If
    Next 'w
    
    'VBScript用途のためちゃんとNothingを返しておく。
    Set FindIEByHwnd = Nothing
End Function

上記VBScriptのVBAからの使用例です。

Dim vbsFile As String
vbsFile = 上記ファイルへのパス

Dim cmd As String
cmd = "wscript.exe ""{vbsPath}"" /HWND:{HWND}"
cmd = VBA.Strings.Replace(cmd, "{vbsPath}", vbsFile)
cmd = VBA.Strings.Replace(cmd, "{HWND}", objIE.HWND)

Call VBA.Interaction.Shell(cmd)

Comments

[sakurasou_petto]

VBScriptの処理を使って何とか動くようになりました。ありがとうございました。

Answer 2

WinAPI Sleep関数を用いて待ち処理を入れると動作が安定しないでしょうか。

'ダイアログ出現まで待つ
Do
    hWindow = FindWindow("#32770", "アップロードするファイルの選択")
    DoEvents: Sleep 50
Loop While hWindow = 0

If hWindow <> 0 Then
    hInputBox1 = FindWindowEx(hWindow, 0&, "ComboBoxEx32", "")
    hInputBox2 = FindWindowEx(hInputBox1, 0&, "ComboBox", "")
    hInputBox3 = FindWindowEx(hInputBox2, 0&, "Edit", "")
    hButton = FindWindowEx(hWindow, 0&, "Button", "開く(&O)")

    DoEvents: Sleep 50
    Call SendMessage(hInputBox3, &HC, 0, "C:\test.jpg") 'ファイルのフルパス入力

    Call SendMessage(hButton, &H6, 1, 0&)  'ボタンをアクティブにする
    Call SendMessage(hButton, &HF5, 0, 0&) 'ボタンをクリックする
End If

＜追記＞
Click直後に以下のようなIE待機処理を入れてみてください。

Dim RepeatSec As Single: RepeatSec = Timer
Do While objIE.Busy = True Or objIE.readyState < 4 'READYSTATE_COMPLETE
    DoEvents
    Sleep 200  '200ms停止       
    If (Timer - RepeatSec) > 60 Then '60秒以上停止
        MsgBox "サーバーが応答していません。"
        End
    End If
Loop

Comments

[sakurasou_petto]

ご回答ありがとうございます。コードをさっそく試したのですが、
Do
hWindow = FindWindow("#32770", "アップロードするファイルの選択")
DoEvents: Sleep 50　/*ここで実行が止まっているよう*/
Loop While hWindow = 0

コメントアウトした部分で止まってしまっているようでした。ファイルを開く前のクリックするところまでの
Set photo=objIE.document.getElementByName("image_tmp")(1)
photo.Click
ここまでは動作しているのですが、そこからやはり動いていないようです。エクスプローラーを開いてからの動作がきちんとしていないようなのですが、ほかに解決策はないでしょうか？

[TanakaHiroaki]

photo.Click の直後に待ち処理を入れてみてください。サンプルコードを追記しました。

解決しない場合、ウィンドウハンドルが取得できているか　Debug.Print　で都度出力させ原因調査するのが良さそうです。

[sakurasou_petto]

photo.Clickの直前と直後にDebug.Print 23というのを打って出力を見てみると、イミディエイトは23の出力が１っ回のみでした。やはりファイルを開いてからファイルをVBAで操作する権限のようなものがなくなっているのでしょうか？

[TanakaHiroaki]

Webサイトの仕様を確認していないので推測ですが、photo.Click　によりVBAが応答待ちの状態になっていると思われます。
その推測が正しければ、VBAはマルチスレッドによる並列処理できないのでVBA以外の知識が必要となり、解決するにはかなり難易度が高いです。