因为我是菜鸟，我不知道这是否可以用 VBA Excel 实现。我试图在多个论坛中找到解决方案，但我真的不知道要寻找什么。
我想做什么: 我想使用 Excel VBA 在网站上自动上传表单。但是我很挣扎，因为单击文件上传按钮会打开一个文件资源管理器(弹出的窗口要求您选择一个文件)。
我尝试了什么: 我发现单击“上传”按钮会触发一个 javascript 函数 doSubmit 以打开文件资源管理器，然后使用它来上传文件。
是否可以使用 VBA 更改文件值并使用新文件值运行 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>
如果您有任何建议，我将不胜感激!
最佳答案
我曾经花了几天时间解决一个类似的问题，我需要将图片上传到网站。最后，我在网上找到了一个脚本，它搜索 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
关于javascript - Excel VBA - 更改 Javascript 函数的值(无参数)，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/49188317/