提问人：Diego Luque 提问时间：11/16/2023 最后编辑：Brian Tompsett - 汤莱恩Diego Luque 更新时间：11/17/2023 访问量：99
用于 Excel VBA 的 CHATPDF API
CHATPDF API for Excel VBA
问：
我在公司中遇到了在 Excel 中设置合同控件的挑战，我想将其与 CHATPDF 帐户集成，以便它使用一些预先选择的问题预先评估文档。
有一个 API API CHATPDF，但我对 python 一无所知，根据定义，我的公司禁用了 excel 加载项。
有没有办法在VBA中重写代码？
已选择的问题示例： 1 - 合同期限是多久？ 2 - 如果不遵守合同，会受到什么处罚？ 3 - ....
Excel 电子表格结构示例：
| 客户 | 日期 | 第1项质询 | 第2项质询 | 第3项质询 |
|---|---|---|---|---|
| C1型 | 单元格 2 | 答案 1 | 答案 2 | 答案 3 |
| C2型 | 单元格 4 | 答案 1 | 答案 2 | 答案 3 |
我尝试上传pdf文件，但它总是返回：
状态：400
错误：{“code”：“BAD_REQUEST”，“message”：“无法读取 PDF”}
Sub EnviarRequisicaoHTTP()
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
' Caminho do arquivo PDF
Dim filePath As String
filePath = "C:\Users\martind3\001.pdf"
' URL da API
Dim url As String
url = "https://api.chatpdf.com/v1/sources/add-file"
' Chave da API
Dim apiKey As String
apiKey = "sec_xxxxxxxxxxxxxxxxx"
' Configurando a solicitação HTTP
http.Open "POST", url, False
http.setRequestHeader "x-api-key", apiKey
' Adicionando o arquivo
Dim formData As String
formData = "multipart/form-data; boundary=----WebKitFormBoundary7MA4YWxkTrZu0gW"
' Lendo o conteúdo do arquivo
Dim fileContents() As Byte
Dim fileNumber As Integer
fileNumber = FreeFile
Open filePath For Binary As fileNumber
ReDim fileContents(LOF(fileNumber) - 1)
Get fileNumber, , fileContents
Close fileNumber
' Construindo a parte do arquivo
Dim boundary As String
boundary = "----WebKitFormBoundary7MA4YWxkTrZu0gW"
Dim body As String
body = "--" & boundary & vbCrLf
body = body & "Content-Disposition: form-data; name=""file""; filename=""file.pdf""" & vbCrLf
body = body & "Content-Type: application/octet-stream" & vbCrLf & vbCrLf
body = body & StrConv(fileContents, vbUnicode) & vbCrLf
body = body & "--" & boundary & "--" & vbCrLf
' Enviando a solicitação
http.setRequestHeader "Content-Type", formData
http.send body
' Manipulando a resposta
If http.Status = 200 Then
MsgBox "Source ID: " & JsonConverter.ParseJson(http.responseText)("sourceId")
Else
MsgBox "Status: " & http.Status & vbCrLf & "Error: " & http.responseText
End If
End Sub
答：
0赞
Diego Luque
11/16/2023
#1
我使用了@Tim威廉姆斯代码，它运行良好。我已经得到了答案，现在是时候循环了。
Option Explicit
Const KEY_CHATPDF As String = "sec_xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
Sub EnviarRequisicaoHTTP()
Const BOUNDARY As String = "----WebKitFormBoundary7MA4YWxkTrZu0gW"
Const URL_ADDFILE As String = "https://api.chatpdf.com/v1/sources/add-file"
Dim http As Object, filePath As String, url As String, formData As String
Dim fileContents() As Byte, body As String, strm As Object
filePath = Range("Arquivo").Value
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Open "POST", URL_ADDFILE, False
http.setRequestHeader "x-api-key", KEY_CHATPDF
http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY
body = "--" & BOUNDARY & vbCrLf
body = body & "Content-Disposition: form-data; name=""file""; filename=""file.pdf""" & vbCrLf
body = body & "Content-Type: application/octet-stream" & vbCrLf & vbCrLf
Set strm = CreateObject("ADODB.Stream")
strm.Open
strm.Position = 0
strm.Type = 1 'binary
strm.Write ToBytes(body)
strm.Write ReadBinary(filePath)
strm.Write ToBytes(vbCrLf & "--" & BOUNDARY & "--" & vbCrLf)
strm.Position = 0
http.send strm.Read()
'Debug.Print http.Status
'Debug.Print http.responsetext
Range("Fonte").Value = http.responsetext
End Sub
Sub EnviarMensagemHTTP()
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
' URL da API
Dim url As String
url = "https://api.chatpdf.com/v1/chats/message"
' Configurando a solicitação HTTP
http.Open "POST", url, False
http.setRequestHeader "referenceSources", True
http.setRequestHeader "x-api-key", KEY_CHATPDF
http.setRequestHeader "Content-Type", "application/json"
' Criando os dados a serem enviados
Dim sourceId As String
sourceId = Range("Fonte").Value
Dim role As String
role = "user"
Dim content As String
content = Range("Pergunta").Value
Dim requestData As String
requestData = "{""sourceId"": """ & sourceId & """, ""messages"": [{""role"": """ & role & """, ""content"": """ & content & """}]}"
' Enviando a solicitação
http.send requestData
'Debug.Print http.Status
'Debug.Print http.responsetext
Range("Resposta").Value = http.responsetext
End Sub
Private Function ReadBinary(strFilePath As String)
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.LoadFromFile strFilePath
ReadBinary = .Read
.Close
End With
End Function
Function ToBytes(str As String) As Variant
With CreateObject("ADODB.Stream")
.Open
.Type = 2 ' text
.Charset = "_autodetect"
.WriteText str
.Position = 0
.Type = 1
ToBytes = .Read
.Close
End With
End Function
评论