VBA 怎么调用OCR识别图片的功能

zpy2

美好未来686 发表于 2019-1-14 11:13
这种接口的代码是怎么写的 ，给个例子看看

http://5809c7f4.nat123.cc:15216/bsbm/pdo/eh/a17/idCard/idCard.html
百度的接口，图片要2m以下,如果手机拍的要压缩一下。上面是百度的接口，可以看看效果。

lilyhcn1

百度的OCR票据接口
https://ai.baidu.com/docs#/OCR-API/5099e085

excel 不太适合做这种事，你自己适配吧

ALYH

fxl447098457 发表于 2019-1-14 08:35
有啊。很多时候有别的语言代码，需要你转化成vba的表达方式。

代码实现的逻辑

大神教我

美好未来686

liucqa 发表于 2019-1-14 10:53
OneNote我写过，c#的。                    

可以把你的C#写的程序封装成DLL 给我调用吗？

zpy2

美好未来686 发表于 2019-1-14 11:13
这种接口的代码是怎么写的 ，给个例子看看

<%

rem http://demon.tw/programming/vbs-post-file.html
rem 参考上面写的vbs上传照片ocr的接口
Class XMLUpload
    Private xmlHttp
    Private objTemp
    Private adTypeBinary, adTypeText
    Private strCharset, strBoundary

    Private Sub Class_Initialize()
        adTypeBinary = 1
        adTypeText = 2
        Set xmlHttp = CreateObject("Msxml2.XMLHTTP")
        Set objTemp = CreateObject("ADODB.Stream")
        objTemp.Type = adTypeBinary
        objTemp.Open
        strCharset = "utf-8"
        strBoundary = GetBoundary()
    End Sub

    Private Sub Class_Terminate()
        objTemp.Close
        Set objTemp = Nothing
        Set xmlHttp = Nothing
    End Sub

    '指定字符集的字符串转字节数组
    Public Function StringToBytes(ByVal strData, ByVal strCharset)
        Dim objFile
        Set objFile = CreateObject("ADODB.Stream")
        objFile.Type = adTypeText
        objFile.Charset = strCharset
        objFile.Open
        objFile.WriteText strData
        objFile.Position = 0
        objFile.Type = adTypeBinary
        If UCase(strCharset) = "UNICODE" Then
            objFile.Position = 2 'delete UNICODE BOM
        ElseIf UCase(strCharset) = "UTF-8" Then
            objFile.Position = 3 'delete UTF-8 BOM
        End If
        StringToBytes = objFile.Read(-1)
        objFile.Close
        Set objFile = Nothing
    End Function

    '获取文件内容的字节数组
    Private Function GetFileBinary(ByVal strPath)
        Dim objFile
        Set objFile = CreateObject("ADODB.Stream")
        objFile.Type = adTypeBinary
        objFile.Open
        objFile.LoadFromFile strPath
        GetFileBinary = objFile.Read(-1)
        objFile.Close
        Set objFile = Nothing
    End Function

    '获取自定义的表单数据分界线
    Private Function GetBoundary()
        Dim ret(12)
        Dim table
        Dim i
        table = "abcdefghijklmnopqrstuvwxzy0123456789"
        Randomize
        For i = 0 To UBound(ret)
            ret(i) = Mid(table, Int(Rnd() * Len(table) + 1), 1)
        Next
        GetBoundary = "---------------------------" & Join(ret, Empty)
    End Function

    '设置上传使用的字符集
    Public Property Let Charset(ByVal strValue)
        strCharset = strValue
    End Property

    '添加文本域的名称和值
    Public Sub AddForm(ByVal strName, ByVal strValue)
        Dim tmp
        tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""\r\n\r\n$3"
        tmp = Replace(tmp, "\r\n", vbCrLf)
        tmp = Replace(tmp, "$1", strBoundary)
        tmp = Replace(tmp, "$2", strName)
        tmp = Replace(tmp, "$3", strValue)
        objTemp.Write StringToBytes(tmp, strCharset)
    End Sub

    '设置文件域的名称/文件名称/文件MIME类型/文件路径或文件字节数组
    Public Sub AddFile(ByVal strName, ByVal strFileName, ByVal strFileType, ByVal strFilePath)
        Dim tmp
        tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""; filename=""$3""\r\nContent-Type: $4\r\n\r\n"
        tmp = Replace(tmp, "\r\n", vbCrLf)
        tmp = Replace(tmp, "$1", strBoundary)
        tmp = Replace(tmp, "$2", strName)
        tmp = Replace(tmp, "$3", strFileName)
        tmp = Replace(tmp, "$4", strFileType)
        objTemp.Write StringToBytes(tmp, strCharset)
        objTemp.Write GetFileBinary(strFilePath)
    End Sub

    '设置multipart/form-data结束标记
    Private Sub AddEnd()
        Dim tmp
        tmp = "\r\n--$1--\r\n"
        tmp = Replace(tmp, "\r\n", vbCrLf)
        tmp = Replace(tmp, "$1", strBoundary)
        objTemp.Write StringToBytes(tmp, strCharset)
        objTemp.Position = 2
    End Sub

    '上传到指定的URL，并返回服务器应答
    Public Function Upload(ByVal strURL)
        Call AddEnd
        xmlHttp.Open "POST", strURL, False
        xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary
        'xmlHttp.setRequestHeader "Content-Length", objTemp.size
        xmlHttp.Send objTemp
        Upload = xmlHttp.responseText
    End Function
End Class

Dim UploadData
Set UploadData = New XMLUpload
UploadData.Charset = "utf-8"
UploadData.AddForm "content", "Hello world" '文本域的名称和内容
rem UploadData.AddFile "file", "test.jpg", "image/jpg", "test.jpg"
Response.Write Server.MapPath("./test.jpg")
rem VBA 下面这句要修改为
rem uploadFile="test.jpg"
uploadFile=Server.MapPath("./test.jpg")
UploadData.AddFile "file", "test.jpg", "image/jpg", uploadFile

rem WScript.Echo UploadData.Upload("http://5809c7f4.nat123.cc:15216/bsbm/pdo/eh/a17/invoice/index.php")
rem VBA下面这句要修改为
rem debug.print UploadData.Upload("http://5809c7f4.nat123.cc:15216/bsbm/pdo/eh/a17/invoice/handle.php")

Response.Write UploadData.Upload("http://5809c7f4.nat123.cc:15216/bsbm/pdo/eh/a17/invoice/handle.php")
Set UploadData = Nothing
%>

fwa103

收藏，留着备用

五指山888

fwa103 发表于 2021-2-8 17:00
收藏，留着备用

收藏，留着备用

zhzhang9756

remaek一下

池盛龙

美好未来686 发表于 2019-1-14 11:13
这种接口的代码是怎么写的 ，给个例子看看

https://club.excelhome.net/thread-1637781-1-1.html 看看是不是要这样