VBA OCR 通过 API https://ocr.space

Question

我想使用 https://ocr.space/ 的 API 来查找给定的文本位置。我看到了一些主题，但其中 none 个是 VBA 相关的。

我现在的代码是：

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

我用来获取图片的 base64 字符串的代码如下，但它似乎工作正常，因为如果我将它粘贴到在线转换器，我可以取回图片。

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

你能帮我找出我做错了什么吗？

Answer 1

我尝试了不同的方法。

现在我上传文件本身而不是创建一个 base64 字符串（无论如何我都会在我的电脑上有图片）。

代码是从某处复制的，但我不记得在哪里找到的。

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

终于在大约 2 个月后我找到了解决方案 :D 我只需要在这里注册 :P

VBA OCR 通过 API https://ocr.space

VBA OCR via API https://ocr.space

api

ocr

excel

vba

ocrspace-ocr-api