Reputation: 487
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
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.
Upvotes: 2