Excel 通过API实现VBA OCRhttps://ocr.space

我想使用的API来查找给定的文本位置。 我看到了一些主题，但没有一个与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

---

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

我尝试了另一种方法

现在，我上传文件本身，而不是创建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

大约两个月后，我终于有了一个解决方案：D

---

我必须在这里注册：P

你好，谢谢你的快速回复。实际上它是通过邮递员工作的，我做了如下工作：POST:No auth。设置，无标题，正文：表单数据，添加了：Apikey、语言、isOverlayRequired和base64Image。就这样，我一秒钟就得到了答案。我想我应该修改通过VBA在体内发送信息的方式。这部分应该是有问题的部分：httpReq.send“base64Image=data:image/png；base64，&pic&“&isoverlaydired=true”有什么想法吗？我过去经常检查，但上面的函数给了我一个很好的结果，还有邮差。问题是我不想使用postman，我只想通过宏发送它。