Sam
Sam

Reputation: 487

VBA Excel put cell value in web form

In the following Code i am trying to put the value in the cell A1 (which is an address in the upload window) that popup; is there a way to put the value in the cell A1 in sheet1 (in the file name textbox) and then press ok , by simulating that in VBA , i thought about sendkeys but its not working

here is my current code: I am referencing 2 libraries : Microsoft HTML Object Library Microsoft Internet Controls

    Sub GetBase64()

Dim ie As New InternetExplorer
Dim doc As HTMLDocument
ie.Visible = True
ie.navigate ("http://webcodertools.com/imagetobase64converter/Create")
Do While ie.Busy
  Application.Wait DateAdd("s", 1, Now)
Loop

Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE

Set doc = ie.document

doc.getElementById("file").Click

End Sub

Thanks for your help

Upvotes: 0

Views: 4309

Answers (1)

David Zemens
David Zemens

Reputation: 53623

I made some modifications to your code, incorporating the solution described here.

In my limited past experience, it's tricky and/or impossible to grab the handle of those "Open" dialog boxes, and SendKeys is notoriously unreliable.

I have tested this and the GetBase64 function now assigns two more variables imgTag and css which you might need, they are the "results" of the upload.

Public ie As InternetExplorer
Sub GetBase64()
Dim doc As HTMLDocument
Const URL As String = "http://webcodertools.com/imagetobase64converter/Create"
Dim sFile As String
Dim e As Variant
Dim imgTag As String
Dim css As String

sFile = Range("A1").Value
Set ie = CreateObject("InternetExplorer.Application")

With ie
    .Visible = True
    .navigate URL
    Do
        DoEvents
    Loop Until .readyState = 4

    UploadFile URL, sFile, "file"

    'Now, get the strings from the IE window
    Set doc = .document

    For Each e In doc.getElementsByTagName("textarea")
    '## This is not the most sophisticated way of doing this, but it works:
        If Left(e.innerText, 1) = "<" Then
            imgTag = e.innerText
        Else:
            css = e.innerText
        End If
    Next

End With


End Sub


Sub UploadFile(DestURL As String, FileName As String, _
  Optional ByVal FieldName As String = "File")
  Dim sFormData As String, d As String

  'Boundary of fields.
  'Be sure this string is Not In the source file
  Const Boundary As String = "---------------------------0123456789012"

  'Get source file As a string.
  sFormData = GetFile(FileName)

  'Build source form with file contents
  d = "--" + Boundary + vbCrLf
  d = d + "Content-Disposition: form-data; name=""" + FieldName + """;"
  d = d + " filename=""" + FileName + """" + vbCrLf
  d = d + "Content-Type: application/upload" + vbCrLf + vbCrLf
  d = d + sFormData
  d = d + vbCrLf + "--" + Boundary + "--" + vbCrLf

  'Post the data To the destination URL
  IEPostStringRequest DestURL, d, Boundary
End Sub

'sends URL encoded form data To the URL using IE
Sub IEPostStringRequest(URL As String, FormData As String, Boundary As String)

Dim WebBrowser As Object
Set WebBrowser = ie
  'Send the form data To URL As POST request
  Dim bFormData() As Byte
  ReDim bFormData(Len(FormData) - 1)
  bFormData = StrConv(FormData, vbFromUnicode)

  WebBrowser.navigate URL, , , bFormData, _
    "Content-Type: multipart/form-data; boundary=" + Boundary + vbCrLf

  Do While WebBrowser.Busy
'    Sleep 100
    DoEvents
  Loop
'Leave the browser open
'  WebBrowser.Quit
End Sub

'read binary file As a string value
Function GetFile(FileName As String) As String
  Dim FileContents() As Byte, FileNumber As Integer
  ReDim FileContents(FileLen(FileName) - 1)
  FileNumber = FreeFile
  Open FileName For Binary As FileNumber
    Get FileNumber, , FileContents
  Close FileNumber
  GetFile = StrConv(FileContents, vbUnicode)
End Function
'******************* upload - end

Update Here is a screenshot of successful use on my computer, note that I used late binding (ie as Object, doc As Object) when I test this to avoid needing the References; but as long as you have those references enabled, you should be able to Dim them as the specific object types.

enter image description here

Upvotes: 2

Related Questions