VBA OCR via API https://ocr.space

Question

i would like to use the API of https://ocr.space/ to look for given text positions. I saw some topics but none of them was VBA related.

My code at the moment is:

Sub test()
Dim pic As String
Dim httpReq As New XMLHTTP60
Dim UserName, Key As String
UserName = Sheets("main").Range("B8") 
Key = Sheets("main").Range("B9")

pic = "C:\Users\myname\Desktop\Capture.png"
pic = EncodeFile(pic)

     strURL = "https://api.ocr.space/Parse/Image"
     httpReq.Open "POST", strURL, False, UserName, Key

     httpReq.setRequestHeader "Content-Type", "form-data" '  "application/x-www-form-urlencoded?"
     httpReq.setRequestHeader UserName, Key    
     httpReq.send "base64Image=data:image/png;base64," & pic & "&isOverlayRequired=true"

     resp = httpReq.responseText

MsgBox resp

End Sub

The code I use to get the base64 string of the picture is the following, however it seems to work fine, as I can get back the picture if i paste it to an online converter.

Public Function EncodeFile(strPicPath As String) As String
    Const adTypeBinary = 1          ' Binary file is encoded

    ' Variables for encoding
    Dim objXML
    Dim objDocElem

    ' Variable for reading binary picture
    Dim objStream

    ' Open data stream from picture
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeBinary
    objStream.Open
    objStream.LoadFromFile (strPicPath)

    ' Create XML Document object and root node
    ' that will contain the data
    Set objXML = CreateObject("MSXml2.DOMDocument")
    Set objDocElem = objXML.createElement("Base64Data")
    objDocElem.DataType = "bin.base64"

    ' Set binary value
    objDocElem.nodeTypedValue = objStream.Read()

    ' Get base64 value
    EncodeFile = objDocElem.Text

    ' Clean all
    Set objXML = Nothing
    Set objDocElem = Nothing
    Set objStream = Nothing

End Function

Could you please help me to find what do I do wrong?

Answer 1

I tried a different approach.

Now I upload the files itself instead of creating a base64 string ( as I would have the picture on my pc anyway).

The code is copied from somewhere, but I can not recall where I found it.

Sub uploader()

a = Upload("https://api.ocr.space/Parse/Image", "C:\Users\xxxxxxxxxxxxxxxxx\Desktop\Capture.png", "isOverlayRequired=true", "isOverlayRequired=true")

MsgBox a

End Sub



Function Upload(strUploadUrl, strFilePath, strFileField, strDataPairs)

Const MULTIPART_BOUNDARY = "---------------------------0123456789012"
Dim ado, rs
Dim lngCount
Dim bytFormData, bytFormStart, bytFormEnd, bytFile
Dim strFormStart, strFormEnd, strDataPair
Dim web

UserName = Sheets("main").Range("B8")
Key = Sheets("main").Range("B9")

Const adLongVarBinary = 205
    'Read the file into a byte array
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1
    ado.Open
    ado.LoadFromFile strFilePath
    bytFile = ado.Read
    ado.Close
    'Create the multipart form data.
    'Define the end of form
    strFormEnd = vbCrLf & "--" & MULTIPART_BOUNDARY & "--" & vbCrLf
    'First add any ordinary form data pairs
    strFormStart = ""
    For Each strDataPair In Split(strDataPairs, "|")
        strFormStart = strFormStart & "--" & MULTIPART_BOUNDARY & vbCrLf
        strFormStart = strFormStart & "Content-Disposition: form-data; "
        strFormStart = strFormStart & "name=""" & Split(strDataPair, "=")(0) & """"
        strFormStart = strFormStart & vbCrLf & vbCrLf
        strFormStart = strFormStart & Split(strDataPair, "=")(1)
        strFormStart = strFormStart & vbCrLf
    Next
    'Now add the header for the uploaded file
    strFormStart = strFormStart & "--" & MULTIPART_BOUNDARY & vbCrLf
    strFormStart = strFormStart & "Content-Disposition: form-data; "
    strFormStart = strFormStart & "name=""" & strFileField & """; "
    strFormStart = strFormStart & "filename=""" & Mid(strFilePath, InStrRev(strFilePath, "\") + 1) & """"
    strFormStart = strFormStart & vbCrLf
    strFormStart = strFormStart & "Content-Type: application/upload" 'bogus, but it works
    strFormStart = strFormStart & vbCrLf & vbCrLf

    'Create a recordset large enough to hold everything
    Set rs = CreateObject("ADODB.Recordset")
    rs.Fields.Append "FormData", adLongVarBinary, Len(strFormStart) + LenB(bytFile) + Len(strFormEnd)
    rs.Open
    rs.AddNew
    'Convert form data so far to zero-terminated byte array
    For lngCount = 1 To Len(strFormStart)
        bytFormStart = bytFormStart & ChrB(Asc(Mid(strFormStart, lngCount, 1)))
    Next
    rs("FormData").AppendChunk bytFormStart & ChrB(0)
    bytFormStart = rs("formData").GetChunk(Len(strFormStart))
    rs("FormData") = ""
    'Get the end boundary as a zero-terminated byte array
    For lngCount = 1 To Len(strFormEnd)
        bytFormEnd = bytFormEnd & ChrB(Asc(Mid(strFormEnd, lngCount, 1)))
    Next
    rs("FormData").AppendChunk bytFormEnd & ChrB(0)
    bytFormEnd = rs("formData").GetChunk(Len(strFormEnd))
    rs("FormData") = ""
    'Now merge it all
    rs("FormData").AppendChunk bytFormStart
    rs("FormData").AppendChunk bytFile
    rs("FormData").AppendChunk bytFormEnd
    bytFormData = rs("FormData")
    rs.Close
    'Upload it
    Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
    web.Open "POST", strUploadUrl, False
    web.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & MULTIPART_BOUNDARY
    web.setRequestHeader UserName, Key
    web.setRequestHeader "isOverlayRequired", "true"
    web.send bytFormData

    Upload = web.responseText

End Function

Finally after like 2 months i have a solution :D I just had to register here :P