CODEWITHSUNDEEP
excelvbawebfiledialog
alexandre
alexandre

Reputation: 73

How to control an already open Web File Dialog with VBA?

I'm trying to Upload an Image in my company's intranet site. But it opens a FileDialog, and I need to select some file then click on "OK" Button. But I don't want to do that using sendKeys. Does anyone know how to control those Microsoft Windows FileDialog, with VBA. Just the "file name" field, and the OK button.

Sorry If I don't have any code. That's becouse I could not find anyone. Have no Idea.

Upvotes: 2

Views: 686

Answers (1)

omegastripes
omegastripes

Reputation: 12602

The most efficient way is to upload files via XHR. In your browser open Developer tools, Network tab, open the intranet site webpage, make a file upload as usual. Then, based on the parameters from the last logged POST request, you can construct the same XHR.

As an example, here is the code that implements a functionality of a simplest webform, containing the only field of file type:

Sub UploadTest()

    Dim strUplStatus, strUplResponse

    UploadFile "C:\image.jpg", strUplStatus, strUplResponse
    MsgBox strUplStatus & vbCrLf & strUplResponse

End Sub

Sub UploadFile(strPath, strStatus, strResponse)

    Dim strFile, strExt, strContentType, strBoundary, bytData, bytPayLoad

    On Error Resume Next
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(strPath) Then
            strFile = .GetFileName(strPath)
            strExt = .GetExtensionName(strPath)
        Else
            strStatus = "File not found"
            Exit Sub
        End If
    End With
    With CreateObject("Scripting.Dictionary")
        .Add "txt", "text/plain"
        .Add "html", "text/html"
        .Add "php", "application/x-php"
        .Add "js", "application/x-javascript"
        .Add "vbs", "application/x-vbs"
        .Add "bat", "application/x-bat"
        .Add "jpeg", "image/jpeg"
        .Add "jpg", "image/jpeg"
        .Add "png", "image/png"
        .Add "exe", "application/exe"
        .Add "doc", "application/msword"
        .Add "docx", "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
        .Add "xls", "application/vnd.ms-excel"
        .Add "xlsx", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
        strContentType = .Item(LCase(strExt))
    End With
    If strContentType = "" Then
        strStatus = "Invalid file type"
        Exit Sub
    End If
    With CreateObject("ADODB.Stream")
        .Type = 1
        .Mode = 3
        .Open
        .LoadFromFile strPath
        If Err.Number <> 0 Then
            strStatus = Err.Description & " (" & Err.Number & ")"
            Exit Sub
        End If
        bytData = .Read
    End With
    strBoundary = String(6, "-") & Replace(Mid(CreateObject("Scriptlet.TypeLib").GUID, 2, 36), "-", "")
    With CreateObject("ADODB.Stream")
        .Mode = 3
        .Charset = "Windows-1252" ' Latin
        .Open
        .Type = 2
        .WriteText "--" & strBoundary & vbCrLf
        .WriteText "Content-Disposition: form-data; name=""upload_file""; filename=""" & strFile & """" & vbCrLf
        .WriteText "Content-Type: """ & strContentType & """" & vbCrLf & vbCrLf
        .Position = 0
        .Type = 1
        .Position = .Size
        .Write bytData
        .Position = 0
        .Type = 2
        .Position = .Size
        .WriteText vbCrLf & "--" & strBoundary & "--"
        .Position = 0
        .Type = 1
        bytPayLoad = .Read
    End With
    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", "http://mysite/upload.php", False
        .SetRequestHeader "Content-type", "multipart/form-data; boundary=" & strBoundary
        .Send bytPayLoad
        If Err.Number <> 0 Then
            strStatus = Err.Description & " (" & Err.Number & ")"
        Else
            strStatus = .StatusText & " (" & .Status & ")"
        End If
        If .Status = "200" Then strResponse = .ResponseText
    End With

End Sub

Upvotes: 1

Related Questions