I can post the file to a deal, but when i try to open the file it says file is unreadable? The file works to open on my computer.
here is the code fromVBA
Dim dealId As String
Dim companyDomain As String
Dim apiToken As String
Dim filePath As String
Dim url As String
Dim boundary As String
Dim response As String
Dim byteArray() As Byte
' Hämta värden från Excel-celler
dealId = ThisWorkbook.Sheets(1).Range("A2").Value
companyDomain = ThisWorkbook.Sheets(1).Range("B2").Value
apiToken = ThisWorkbook.Sheets(1).Range("C2").Value
filePath = "C:\Users\P7015\E.ON\Operations - General\4. Teknisk Design\TEST\Avtalsvillkor.pdf"
' Kontrollera om filen finns
If Dir(filePath) = "" Then
MsgBox "Filen hittades inte: " & filePath, vbCritical
Exit Sub
End If
' Skapa URL för att lägga till en fil
url = "https://" & companyDomain & ".pipedrive.com/api/v1/files?api_token=" & apiToken
' Skapa gräns för multipart/form-data
boundary = "----WebKitFormBoundary" & Format(Now, "yyyyMMddHHmmss")
' Läs filens binära data
byteArray = ReadBinaryFile(filePath)
If IsEmpty(byteArray) Then
MsgBox "Kunde inte läsa filens binära data", vbCritical
Exit Sub
End If
' Skicka POST-förfrågan
response = SendPostRequest(url, boundary, byteArray, dealId, "Avtalsvillkor.pdf")
If response = "" Then
MsgBox "Ingen respons från servern", vbCritical
Else
' Visa svar
MsgBox response
End If
End Sub
Function ReadBinaryFile(filePath As String) As Byte()
Dim binaryStream As Object
Dim byteArray() As Byte
On Error GoTo ErrorHandler
Set binaryStream = CreateObject(“ADODB.Stream”)
binaryStream.Type = 1 ’ adTypeBinary
binaryStream.Open
binaryStream.LoadFromFile filePath
byteArray = binaryStream.Read
binaryStream.Close
Set binaryStream = Nothing
ReadBinaryFile = byteArray
Exit Function
ErrorHandler:
MsgBox "Fel vid läsning av fil: " & Err.Description, vbCritical
ReadBinaryFile = Empty
End Function
Function SendPostRequest(url As String, boundary As String, fileData() As Byte, dealId As String, fileName As String) As String
Dim http As Object
Dim postData As String
Dim startData As String
Dim endData As String
Dim startBytes() As Byte
Dim endBytes() As Byte
Dim fullData() As Byte
' Skapa startdata för POST-förfrågan
startData = "--" & boundary & vbCrLf
startData = startData & "Content-Disposition: form-data; name=""deal_id""" & vbCrLf & vbCrLf
startData = startData & dealId & vbCrLf
startData = startData & "--" & boundary & vbCrLf
startData = startData & "Content-Disposition: form-data; name=""file""; filename=""" & fileName & """" & vbCrLf
startData = startData & "Content-Type: application/pdf" & vbCrLf & vbCrLf
' Skapa slutdata för POST-förfrågan
endData = vbCrLf & "--" & boundary & "--"
' Konvertera strängar till byte-arrayer
startBytes = StrConv(startData, vbFromUnicode)
endBytes = StrConv(endData, vbFromUnicode)
' Kombinera startData, fileData och endData till en byte-array
fullData = JoinByteArrays(startBytes, fileData)
fullData = JoinByteArrays(fullData, endBytes)
' Lägg till debug-utskrifter för att felsöka
Debug.Print "Start Data: " & startData
Debug.Print "End Data: " & endData
Debug.Print "Full Data Length: " & UBound(fullData) - LBound(fullData) + 1
' Skicka HTTP POST-förfrågan
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "POST", url, False
http.setRequestHeader "Accept", "application/json"
http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
On Error GoTo ErrorHandler
http.send fullData
On Error GoTo 0
SendPostRequest = http.responseText
Exit Function
ErrorHandler:
MsgBox "Fel vid sändning av HTTP-förfrågan: " & Err.Description, vbCritical
SendPostRequest = “”
End Function
Function JoinByteArrays(array1() As Byte, array2() As Byte) As Byte()
Dim result() As Byte
Dim length1 As Long
Dim length2 As Long
length1 = UBound(array1) - LBound(array1) + 1
length2 = UBound(array2) - LBound(array2) + 1
ReDim result(0 To length1 + length2 - 1) As Byte
Dim i As Long
For i = 0 To length1 - 1
result(i) = array1(i)
Next i
For i = 0 To length2 - 1
result(length1 + i) = array2(i)
Next i
JoinByteArrays = result
End Function