使用 API 将图像从 MS Access 上传到 Google Drive 时出现问题

问题描述 投票：0回答：1

在我的 MS Access 数据库中，我想使用 VBA 中的 Google Drive API 使用 HTTPS Post 请求将我的客户个人资料照片上传到我的 Google Drive。我已成功将照片上传到我的 Google 云端硬盘，但该格式不受支持。要使用 https post 请求上传照片，我需要将图像转换为 Base64 字符串。上传后，我无法查看或打开照片，直到下载照片并将文件扩展名从“jpg”重命名为“txt”。重命名文件后，我可以在记事本中打开该文件并查看 Base64 字符串。如果我转换 Base64 字符串，那么我就可以看到照片。如何转换 Base64 图像？我使用这样的 HTML img 标签

<!DOCTYPE html>
<head>
</head>
    <body>
       <img src="data:image/jpg;base64,/9j/4QEcRXhpZgAATU0AKgA(This is the Base64 text................" alt=""> 
    </body>
</html>

这样我就可以看到照片了。我用于将图像上传到谷歌驱动器的VBA代码是

Option Compare Database

Sub UploadFileToGoogleDrive71()
    Dim imageFile As String
    Dim imageBytes() As Byte
    Dim base64String As String
    Dim boundary As String
    Dim request As Object
    Dim accessToken As String
    
    ' Your access token
    accessToken = "ya29.a0Ad52N3_EtFDYr_3lTO-i1P0sNbqgUXzvp..........."
    
    ' Path to your image file
    imageFile = Forms!PatientFormF2!PatientPhotoPath.Value
    
    ' Read the image file into a byte array
    Open imageFile For Binary As #1
    ReDim imageBytes(LOF(1) - 1)
    Get #1, , imageBytes
    Close #1
    
    ' Encode the byte array as a Base64 string
    base64String = EncodeBase64(imageBytes)
    
    ' Construct the boundary for the multipart/form-data request
    boundary = "---------------------------" & Format(Now, "hhmmss") & "abcd"
    
    ' Create the HTTP request object
    Set request = CreateObject("MSXML2.XMLHTTP")
    
    Dim folderId As String
    ' Set the folder ID where you want to upload the photos
    folderId = "1EptP5DEg_m2DE1N67sQ........"
    
    ' Set up the request
    request.Open "POST", "https://www.googleapis.com/upload/drive/v3/files?uploadType=multipart", False
    request.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
    request.setRequestHeader "Content-Length", Len(postData) ' Set the Content-Length header
    request.setRequestHeader "Authorization", "Bearer " & accessToken ' Set the Authorization header
    
    ' Construct the request payload
    Dim requestData As String
    requestData = "--" & boundary & vbCrLf
    requestData = requestData & "Content-Type: application/json; charset=UTF-8" & vbCrLf & vbCrLf
    requestData = requestData & "{""name"": ""uploaded_image.jpg"", ""parents"": [""" & folderId & """]}" & vbCrLf & vbCrLf
    requestData = requestData & "--" & boundary & vbCrLf
    requestData = requestData & "Content-Type: image/jpeg" & vbCrLf & vbCrLf
    requestData = requestData & base64String & vbCrLf
    requestData = requestData & "--" & boundary & "--"
    
    ' Send the request
    request.Send requestData

    ' Check the response
    If request.status = 200 Then
        MsgBox "File uploaded successfully!"
    Else
        MsgBox "Error uploading file: " & request.StatusText
    End If
End Sub

Function EncodeBase64(data() As Byte) As String
    Dim objXML As Object
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Dim objNode As Object

    ' Convert byte array to base64 string
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = data
    EncodeBase64 = objNode.Text

    Set objNode = Nothing
    Set objXML = Nothing
End Function

我想使用谷歌驱动器API从我的MS Access数据库上传图像，并且能够直接在谷歌驱动器中查看照片，也能够通过下载它们来查看照片。预先感谢您的任何帮助。

vba api ms-access https google-drive-api
1个回答
0
投票

我解决问题

Sub UploadFileToGoogleDrive71()
    Dim imageFile As String
    Dim imageBytes() As Byte
    Dim base64String As String
    Dim boundary As String
    Dim request As Object
    Dim accessToken As String
    
    ' Your access token
    accessToken = "ya29.a0AXooCgtBXWyRhS............."
    
    ' Path to your image file
    imageFile = Forms!PatientFormF!PatientPhotoPath.value
    
    ' Read the image file into a byte array
    Open imageFile For Binary As #1
    ReDim imageBytes(LOF(1) - 1)
    Get #1, , imageBytes
    Close #1
    
    ' Encode the byte array as a Base64 string
    base64String = EncodeBase64(imageBytes)
    
    ' Construct the boundary for the multipart/form-data request
    boundary = "---------------------------" & Format(Now, "hhmmss") & "abcd"
    
    ' Create the HTTP request object
    Set request = CreateObject("MSXML2.XMLHTTP")
    
    Dim folderId As String
    ' Set the folder ID where you want to upload the photos
    folderId = "1EptP5DEg_m2DE............"
    
    ' Set up the request
    request.Open "POST", "https://www.googleapis.com/upload/drive/v3/files?uploadType=multipart", False
    request.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
    request.setRequestHeader "Content-Length", Len(postData) ' Set the Content-Length header
    request.setRequestHeader "Authorization", "Bearer " & accessToken ' Set the Authorization header
    
    ' Construct the request payload
    Dim requestData As String
    requestData = "--" & boundary & vbCrLf
    requestData = requestData & "Content-Type: application/json; charset=UTF-8" & vbCrLf & vbCrLf
    requestData = requestData & "{""name"": ""uploaded_image.jpg"", ""parents"": [""" & folderId & """]}" & vbCrLf & vbCrLf
    requestData = requestData & "--" & boundary & vbCrLf
    requestData = requestData & "Content-Type: image/jpeg" & vbCrLf
    requestData = requestData & "Content-Transfer-Encoding: base64" & vbCrLf & vbCrLf ' Add Content-Transfer-Encoding header
    requestData = requestData & base64String & vbCrLf
    requestData = requestData & "--" & boundary & "--"
    
    ' Send the request
    request.send requestData

    ' Check the response
    If request.status = 200 Then
        MsgBox "File uploaded successfully!"
    Else
        MsgBox "Error uploading file: " & request.StatusText
    End If
End Sub

Function EncodeBase64(data() As Byte) As String
    Dim objXML As Object
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Dim objNode As Object

    ' Convert byte array to base64 string
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = data
    EncodeBase64 = objNode.Text

    Set objNode = Nothing
    Set objXML = Nothing
End Function
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.