Sub BC_识别身份证( ) Dim SHD, SHX As WorksheetDim AppKey, SecretKey, Token, PathY As StringDim jSon, JSonA, WithHttp As ObjectDim Pic, oDom, oW, jsCode, paramsDim ARX, BRX, DRX, ERX, ZADDim StrText, StrUrl As StringDim StrA, StrB, StrC As StringDim I, X, K As LongRem 禁止系统刷屏?触发其他事件等'On Error Resume Next ' // 发生错误，自动执行下一句，就是忽略错误Rem 获取百度TokenSet SHX = Worksheets( "参数" ) AppKey = SHX. Range( "B1" ) . ValueSecretKey = SHX. Range( "B2" ) . ValueToken = GetTokenBaiDu( AppKey:= AppKey, SecretKey:= SecretKey) Rem 指定发票文件, 可以是PDF, 或JPG, PNG文件, 暂不支持: 一张放票内多条明细, 一个文件内多张发票PathY = GetFileName( KZM:= "图片文件,*.png;*.bmp;*.jpeg;*.jpg" , Title:= "请选择图片文件" , FileName:= "" , StrSplitor:= "\") Open PathY For Binary As Dim chs( ) As ByteFor I = 0 To LOF( 1 ) - 1 '循环至文件末端ReDim Preserve chs( 0 To K) As Byte '将文件内容存入字节数组Get K = K + 1 Next IClose Pic = Byte2Base64( chs) Set oDom = CreateObject( "htmlfile" ) Set oW = oDom. parentWindowjsCode = "encodeURIComponent('" & Pic & "');" Pic = oW. eval ( jsCode) Rem Pic = WorksheetFunction. EncodeURL( Pic) params = "id_card_side=" + "front" + "&image=" & Pic' params = "image=" & PicStrUrl = "https://aip.baidubce.com/rest/2.0/ocr/v1/idcard?access_token=" & TokenSet WithHttp = CreateObject( "winhttp.winhttprequest.5.1" ) With WithHttp. Open "post" , StrUrl, False . setRequestHeader "content-type" , "application/x-www-form-urlencoded" . send ( params) StrText = BytesToBstr( . Responsebody, "utf-8" ) End WithSet oDom = NothingSet oW = NothingRem SHX. Range( "G4" ) . Value = StrText '// StrText = SHX. Range( "G4" ) . ValueRem 创建JSON对象并将其赋值为要解析的JSON字符串Set jSon = JsonConverter. ParseJson( StrText) Rem jSon. Count & vbCrLf & jSon. Items( ) ( 0 ) & vbCrLf & jSon. keys( ) ( 0 ) Rem JSON( "forecast" ) ( "forecastday" ) ( "hour" ) ( i) ( "time_epoch" ) Rem IntX = jSon( "words_result" ) ( "CommodityName" ) . CountRem 写到字典中Set ZAD = CreateObject( "Scripting.Dictionary" ) If InStr( StrText, "姓名" ) = 0 ThenIf InStr( StrText, "签发日期" ) > 0 ThenZAD( "签发日期" ) = jSon( "words_result" ) ( "签发日期" ) ( "words" ) ZAD( "失效日期" ) = jSon( "words_result" ) ( "失效日期" ) ( "words" ) ZAD( "签发机关" ) = jSon( "words_result" ) ( "签发机关" ) ( "words" ) ElseZAD( "错误" ) = "识别失败,返回结果错误" End IfElseZAD( "姓名" ) = jSon( "words_result" ) ( "姓名" ) ( "words" ) ZAD( "性别" ) = jSon( "words_result" ) ( "性别" ) ( "words" ) ZAD( "出生日期" ) = jSon( "words_result" ) ( "出生" ) ( "words" ) ZAD( "身份号码" ) = jSon( "words_result" ) ( "公民身份号码" ) ( "words" ) ZAD( "民族" ) = jSon( "words_result" ) ( "民族" ) ( "words" ) ZAD( "住址" ) = jSon( "words_result" ) ( "住址" ) ( "words" ) End IfRem 写入数组并输出ERX = ZAD. keysReDim DRX( 0 To UBound( ERX) , 0 To 1 ) For X = 0 To UBound( ERX) DRX( X, 0 ) = ERX( X) DRX( X, 1 ) = ZAD( ERX( X) ) NextSet SHD = Worksheets( "test" ) SHD. Range( "A:B" ) . ClearContentsSHD. Range( "A1" ) . Resize( UBound( DRX, 1 ) + 1 , UBound( DRX, 2 ) + 1 ) = DRXMsgBox UBound( DRX, 1 ) , vbInformation, "识别成功"
End Sub
