由于我是菜鸟，我不知道VBA Excel是否可以实现这一点。我试图在几个论坛中找到解决方案，但我真的不知道该寻找什么。
我想做什么： 我想在使用Excel VBA的网站上自动上传表单。但是我很难过，因为单击文件上传按钮会打开一个文件浏览器（弹出的窗口会要求您选择一个文件）。
我尝试了什么： 我发现点击上传按钮会触发一个javascript函数doSubmit来打开文件资源管理器，然后用它来上传文件。
是否可以使用VBA更改fileValue并使用新文件值运行doSubmit函数？
function doSubmit() {
var fileValue = jQuery('#file').val();
按钮的HTML如下所示：
<div class="button-wrapper"><input class="design-file-input" type="file"><a class=" button prio1" href="javascript:void(0);">Design hochladen</a></div>
原始javascript代码如下：
<script type="text/javascript">
var token = "rEjpwK07JxGGqA2jlfG4tzUpqF0fpNKIEf4MZFNhoX8=" || "";
// <![CDATA[
function doSubmit() {
var fileValue = jQuery('#file').val();
if (!fileValue) {
showErrMsg('noFileErrMsg');
return false;
}
if (isVector(fileValue)) {
var form = document.getElementById('upload_design_form');
if(form){
var showError = true;
for (var i = 0; i < form.count_colors.length; i++) {
var obj = form.count_colors[i];
if(obj.checked){
showError = false;
}
}
if(showError){
showErrMsg('colorCountErrMsg');
return false;
}
}
}
if (!document.getElementById('copyright_check').checked) {
showErrMsg('copyrightErrMsg');
return false;
}
var input = document.createElement("input");
input.setAttribute("type", "hidden");
input.setAttribute("name", "designUploadToken");
input.setAttribute("value", token);
document.getElementById("upload_design_form").appendChild(input);
return true;
}
function isVector(filename) {
var dotIndex;
if (-1 != (dotIndex = filename.lastIndexOf('.'))) {
if (filename.substr(dotIndex + 1).match(/^(fh\d?\d?|cdr|ai|svg|eps|pdf)$/i))
return true;
}
return false;
}
function showErrMsg(err) {
if (!document.getElementById('errMsg')) {
var errMsg = document.createElement('div');
jQuery(errMsg).addClass('message error').attr('id', 'errMsg');
document.getElementById('errMsgContainer').appendChild(errMsg);
}
jQuery('#errMsg').html(jQuery('#'+err).html());
}
(function($){
if($){
$('#file').on('change', function(e){
var file = e.target.value;
if(isVector(file)){
$('#colorChooser').slideDown();
}else{
$('#colorChooser').slideUp();
}
});
}
})(jQuery);
// ]]>
</script>
我会感谢您的任何建议！
答案 0 :(得分：1)
我曾经花费数天时间处理类似的问题，我需要将图像上传到网站。最后，我在网上找到了一个脚本，它搜索了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