2

As I am noob I have no idea if this is even possible with VBA Excel. I tried to find a solution in several forums but I don't really know what to look for.

What I Want To Do: I want to automate a upload form on a website with Excel VBA. However I am struggling because clicking the file upload button opens a file explorer (the window that pops up and asks you to choose a file).

What I tried: I figured out that clicking on the Upload button triggers a javascript function doSubmit to open the file explorer and later on use it to upload the file.

Is it possible to change fileValue with VBA and run the doSubmit function using the new file Value?

function doSubmit() {
var fileValue = jQuery('#file').val();

The HTML of the button looks like this:

<div class="button-wrapper"><input class="design-file-input" type="file"><a class=" button prio1" href="javascript:void(0);">Design hochladen</a></div>

The original javascript code is the following:

<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>

I would be thankful for any advice you have!

1 Answer 1

1

I once spend days on a similar problem where I needed to upload images to a website. Eventually, I found a script online which searched for the OpenFileDialog and pasted the filepath in it and pressed submit. It couldn't be triggered from the same Excel instance, so I needed to open a different file with this code in it in a different Excel instance. It has been a couple of years ago, So i'm not into the specifics anymore. Hopefully it can help you:

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
Sign up to request clarification or add additional context in comments.

1 Comment

Thanks to your advice I was able to find, a similar (or the same) solution posted here: Solution

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.