【问题标题】:Excel VBA - Change the Value Of A Javascript Function (No Parameters)Excel VBA - 更改 Javascript 函数的值(无参数)
【发布时间】:2018-03-09 16:13:23
【问题描述】:

因为我是菜鸟,所以我不知道这是否可以使用 VBA Excel。我试图在几个论坛中找到解决方案,但我真的不知道该寻找什么。

我想做的事: 我想用 Excel VBA 在网站上自动上传表单。但是我很挣扎,因为单击文件上传按钮会打开一个文件资源管理器(弹出的窗口并要求您选择一个文件)。

我尝试了什么: 我发现单击“上传”按钮会触发一个 javascript 函数 doSubmit 来打开文件资源管理器,然后使用它来上传文件。

是否可以使用 VBA 更改 fileValue 并使用新的文件 Value 运行 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>

如果您有任何建议,我将不胜感激!

【问题讨论】:

    标签: javascript vba excel


    【解决方案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
    

    【讨论】:

    • 感谢您的建议,我找到了类似(或相同)的解决方案:Solution
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2022-11-20
    • 1970-01-01
    • 2023-03-14
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多