我曾经花了几天时间解决类似的问题,我需要将图像上传到网站。最终,我在网上找到了一个脚本,它搜索 OpenFileDialog 并将文件路径粘贴到其中并按下提交。它无法从同一个 Excel 实例触发,因此我需要在不同的 Excel 实例中打开一个包含此代码的不同文件。已经是几年前的事了,所以我不再详细说明。希望它可以帮助您:
Private Declare PtrSafe Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
'declere API function to get next window for search
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias _
"GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
'declere API function to get lenth of a windows text
Private Declare PtrSafe Function GetWindowTextLength Lib _
"user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
'declere API function to get windows text
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'declere API function to find in child windows
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
'declere API function to find window
Private Declare PtrSafe Function Findwindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal _
hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As _
Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare PtrSafe Function SetCursorPos Lib "user32" _
(ByVal X As Integer, ByVal Y As Integer) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Sub mouse_event Lib "user32.dll" (ByVal dwFlags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN As Long = &H2
'~~> Constants for Releasing left button of the mouse
Private Const MOUSEEVENTF_LEFTUP As Long = &H4
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Private Const WIN_ClassName_FilePath As String = "COMBOBOXEX32" 'class name of filepathbox
Private Const WIN_ClassName_Button As String = "BUTTON" 'class name of buuton
Private Const WM_SETTEXT = &HC 'send messaget value for set text to file path box
Private Const BM_CLICK = &HF5 'send message value to click button
Private Const WIN_NEXT As Long = 2 'value to search window through next
Private Const WIN_PREVIOUS As Long = 3 'value to search window through previous
Sub MP_FileDialog_automation()
Dim Ret As Long, ChildRet As Long, OpenRet As Long
Dim strBuff As String, ButCap As String, Pos As RECT, X As Long, File_Path As String
File_Path = GetSetting("MPAPP", "FileData", "FilePath")
'~~> Get the handle of the "File Download" Window
X = 0
Findwindow:
X = X + 1
Ret = Findwindow(vbNullString, "Bestand selecteren voor uploaden")
If Ret <> 0 Then
'MsgBox "Main Window Found"
Dlg_ChildWIN = FindWindowEx(Ret, 0, WIN_ClassName_FilePath, vbNullString)
If Dlg_ChildWIN <> 0 Then
Dlg_Retun = SendMessage(Dlg_ChildWIN, WM_SETTEXT, 0, ByVal File_Path) 'set file path
If Dlg_Retun <> 1 Then 'Ensure that path set successfully if not exit
MsgBox "Path Not set please try again"
Exit Sub
End If
Else
MsgBox "File path window not found"
Exit Sub
End If
'~~> Get the handle of the Button's "Window"
ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
'~~> Check if we found it or not
If ChildRet <> 0 Then
'MsgBox "Child Window Found"
'~~> Get the caption of the child window
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff
'~~> Loop through all child windows
Do While ChildRet <> 0
'~~> Check if the caption has the word "Open"
'~~> For "Save" or "Cancel", replace "Open" with
'~~> "Save" or "Cancel"
If InStr(1, ButCap, "O") Then
'~~> If this is the button we are looking for then exit
OpenRet = ChildRet
'MsgBox OpenRet
'Exit Do
End If
'~~> Get the handle of the next child window
ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
'~~> Get the caption of the child window
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff
Loop
'~~> Check if we found it or not
If OpenRet <> 0 Then
'~~> Retrieve the dimensions of the bounding rectangle of the
'~~> specified window. The dimensions are given in screen
'~~> coordinates that are relative to the upper-left corner of the screen.
GetWindowRect OpenRet, Pos
'~~> Move the cursor to the specified screen coordinates.
SetCursorPos (Pos.Left - 10), (Pos.Top - 10)
'~~> Suspends the execution of the current thread for a specified interval.
'~~> This give ample amount time for the API to position the cursor
Sleep 100
SetCursorPos Pos.Left, Pos.Top
Sleep 100
SetCursorPos (Pos.Left + Pos.Right) / 2, (Pos.Top + Pos.Bottom) / 2
'~~> Set the size, position, and Z order of "File Download" Window
SetWindowPos Ret, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
Sleep 100
'~~> Simulate mouse motion and click the button
'~~> Simulate LEFT CLICK
mouse_event MOUSEEVENTF_LEFTDOWN, (Pos.Left + Pos.Right) / 2, (Pos.Top + Pos.Bottom) / 2, 0, 0
Sleep 700
'~~> Simulate Release of LEFT CLICK
mouse_event MOUSEEVENTF_LEFTUP, (Pos.Left + Pos.Right) / 2, (Pos.Top + Pos.Bottom) / 2, 0, 0
Else
MsgBox "The Handle of Open Button was not found"
End If
Else
MsgBox "Child Window Not Found"
End If
Else
If X < 4 Then GoTo Findwindow:
End If
End Sub