使用 VBA 上传到 Google Drive？

Uploading to Google drive using VBA?

提问by Glib

I have an MS Access database which now requires me to 'attach' documents to it. My intention is to store the documents on Google Drive and have a link on the database for users to retrieve the documents.

我有一个 MS Access 数据库，现在需要我将文档“附加”到它上面。我的目的是将文档存储在 Google Drive 上，并在数据库上有一个链接供用户检索文档。

As there are many users spread through different cities, it is not practical to require them to have synced Google Drive folders. All the users will need the ability to upload to the database/GD so my intention is to have a separate Google account for the database - with its own login details.

由于有许多用户分布在不同的城市，要求他们同步 Google Drive 文件夹是不切实际的。所有用户都需要能够上传到数据库/GD，所以我的目的是为数据库拥有一个单独的 Google 帐户 - 具有自己的登录详细信息。

example: User clicks button to upload file Save as dialog box appears and user selects file Database logs into its Google Drive and uploads selected file

示例：用户单击按钮上传文件 出现另存为对话框，用户选择文件 数据库登录到其 Google Drive 并上传所选文件

Lots of problems with this though, the main one being that Google Drive does not support VBA. If the user is logged into their own Gmail account, that will probably be another issue.

但这有很多问题，主要问题是 Google Drive 不支持 VBA。如果用户登录到他们自己的 Gmail 帐户，那可能是另一个问题。

I came across this code for vb.net on another site.

我在另一个站点上遇到了 vb.net 的这段代码。

Imports System
Imports System.Diagnostics
Imports DotNetOpenAuth.OAuth2
Imports Google.Apis.Authentication.OAuth2
Imports Google.Apis.Authentication.OAuth2.DotNetOpenAuth
Imports Google.Apis.Drive.v2
Imports Google.Apis.Drive.v2.Data
Imports Google.Apis.Util
Imports Google.Apis.Services

Namespace GoogleDriveSamples

Class DriveCommandLineSample

    Shared Sub Main(ByVal args As String)

        Dim CLIENT_ID As [String] = "YOUR_CLIENT_ID"
        Dim CLIENT_SECRET As [String] = "YOUR_CLIENT_SECRET"

        '' Register the authenticator and create the service
        Dim provider = New    NativeApplicationClient(GoogleAuthenticationServer.Description, CLIENT_ID, CLIENT_SECRET)
        Dim auth = New OAuth2Authenticator(Of NativeApplicationClient)(provider, GetAuthorization)
        Dim service = New DriveService(New BaseClientService.Initializer() With { _
 .Authenticator = auth _
})

        Dim body As New File()
        body.Title = "My document"
        body.Description = "A test document"
        body.MimeType = "text/plain"

        Dim byteArray As Byte() = System.IO.File.ReadAllBytes("document.txt")
        Dim stream As New System.IO.MemoryStream(byteArray)

        Dim request As FilesResource.InsertMediaUpload = service.Files.Insert(body, stream, "text/plain")
        request.Upload()

        Dim file As File = request.ResponseBody
        Console.WriteLine("File id: " + file.Id)
        Console.WriteLine("Press Enter to end this process.")
        Console.ReadLine()
    End Sub



    Private Shared Function GetAuthorization(ByVal arg As NativeApplicationClient) As IAuthorizationState

        ' Get the auth URL:
        Dim state As IAuthorizationState = New AuthorizationState( New () {DriveService.Scopes.Drive.GetStringValue()})

        state.Callback = New Uri(NativeApplicationClient.OutOfBandCallbackUrl)
        Dim authUri As Uri = arg.RequestUserAuthorization(state)

        ' Request authorization from the user (by opening a browser window):
        Process.Start(authUri.ToString())
        Console.Write("  Authorization Code: ")
        Dim authCode As String = Console.ReadLine()
        Console.WriteLine()

        ' Retrieve the access token by using the authorization code:
        Return arg.ProcessUserAuthorization(authCode, state)

    End Function

End Class


End Namespace

It was suggested that the IE library could be utilised to log into the Google Drive and the API calls made from the above to upload. I don't know how to do this. Somewhere else it was mentioned that a 'COM wrapper' may be suitable. I don't have experience with any coding other than VBA (self taught) so am struggling to understand what the next step should be.

建议可以利用IE库登录Google Drive，调用上述API进行上传。我不知道该怎么做。在其他地方提到“COM 包装器”可能是合适的。除了 VBA（自学）之外，我没有任何编码经验，所以我很难理解下一步应该是什么。

If anyone has done something similar or can offer any advice, I would be grateful to hear from you.

如果有人做过类似的事情或可以提供任何建议，我将不胜感激。

回答by James Turner

This thread might be dead now but if you are working with forms in your database and the user needs to be attaching the files to a particular record displayed in a form with a unique identification number then this is definitely possible but you would have to do it in an external application written in .NET I can provide you with the necessary code to get you started, vb.net is very similar to VBA.

这个线程现在可能已经死了，但是如果您正在处理数据库中的表单，并且用户需要将文件附加到以具有唯一标识号的表单中显示的特定记录，那么这绝对是可能的，但您必须这样做在用 .NET 编写的外部应用程序中，我可以为您提供必要的代码来帮助您入门，vb.net 与 VBA 非常相似。

What you would need to do is create a windows form project and add references to Microsoft access core dll and download the nugget package for google drive api from nugget.

您需要做的是创建一个 Windows 窗体项目并添加对 Microsoft 访问核心 dll 的引用，并从 nugget 下载用于 google drive api 的 nugget 包。

Imports Google
Imports Google.Apis.Services
Imports Google.Apis.Drive.v2
Imports Google.Apis.Auth.OAuth2
Imports Google.Apis.Drive.v2.Data
Imports System.Threading


Public Class GoogleDriveAuth

    Public Shared Function GetAuthentication() As DriveService

Dim ClientIDString As String = "Your Client ID"
Dim ClientSecretString As String = "Your Client Secret"
Dim ApplicationNameString As String = "Your Application Name"


        Dim secrets = New ClientSecrets()
        secrets.ClientId = ClientIDString
        secrets.ClientSecret = ClientSecretString

        Dim scope = New List(Of String)
        scope.Add(DriveService.Scope.Drive)

        Dim credential = GoogleWebAuthorizationBroker.AuthorizeAsync(secrets, scope, "user", CancellationToken.None).Result()

        Dim initializer = New BaseClientService.Initializer
        initializer.HttpClientInitializer = credential
        initializer.ApplicationName = ApplicationNameString

        Dim Service = New DriveService(initializer)

        Return Service

    End Function

End Class

This code will authorise your drive service then you create a Public Shared Service As DriveService under your imports that can be used from any sub or function then call this function on your form load event like

此代码将授权您的驱动器服务，然后您在导入下创建一个公共共享服务作为 DriveService 可以从任何子或函数使用，然后在您的表单加载事件上调用此函数，例如

Service = GoogleDriveAuth.GetAuthentication

服务 = GoogleDriveAuth.GetAuthentication

Add a reference to your project to Microsoft Access 12.0 Object Library or whatever version you have

将您的项目引用添加到 Microsoft Access 12.0 对象库或您拥有的任何版本

Then this piece of code will look at the form you want to get the value of the record no from and upload a file to your choice of folder

然后这段代码将查看您想要从中获取记录编号值的表单并将文件上传到您选择的文件夹

Private Sub UploadAttachments()

        Dim NumberExtracted As String

        Dim oAccess As Microsoft.Office.Interop.Access.Application = Nothing
        Dim connectedToAccess As Boolean = False

        Dim SelectedFolderIdent As String = "Your Upload Folder ID"
        Dim CreatedFolderIdent As String

        Dim tryToConnect As Boolean = True

        Dim oForm As Microsoft.Office.Interop.Access.Form
        Dim oCtls As Microsoft.Office.Interop.Access.Controls
        Dim oCtl As Microsoft.Office.Interop.Access.Control
        Dim sForm As String 'name of form to show

        sForm = "Your Form Name"

        Try

            While tryToConnect

                Try
                    ' See if can connect to a running Access instance

                    oAccess = CType(Marshal.GetActiveObject("Access.Application"), Microsoft.Office.Interop.Access.Application)
                    connectedToAccess = True

                Catch ex As Exception

                    Try
                        ' If couldn't connect to running instance of Access try to start a running Access instance And get an updated version of the database

                        oAccess = CType(CreateObject("Access.Application"), Microsoft.Office.Interop.Access.Application)
                        oAccess.Visible = True
                        oAccess.OpenCurrentDatabase("Your Database Path", False)
                        connectedToAccess = True

                    Catch ex2 As Exception

                        Dim res As DialogResult = MessageBox.Show("COULD NOT CONNECT TO OR START THE DATABASE" & vbNewLine & ex2.Message, "Warning", MessageBoxButtons.AbortRetryIgnore, MessageBoxIcon.Warning)

                        If res = System.Windows.Forms.DialogResult.Abort Then
                            Exit Sub
                        End If

                        If res = System.Windows.Forms.DialogResult.Ignore Then
                            tryToConnect = False
                        End If

                    End Try

                End Try

                ' We have connected successfully; stop trying
                tryToConnect = False

            End While

            ' Start a new instance of Access for Automation:
            ' Make sure Access is visible:
            If Not oAccess.Visible Then oAccess.Visible = True

            '  For Each oForm In oAccess.Forms
            '  oAccess.DoCmd.Close(ObjectType:=Microsoft.Office.Interop.Access.AcObjectType.acForm, ObjectName:=oForm.Name, Save:=Microsoft.Office.Interop.Access.AcCloseSave.acSaveNo)
            '  Next
            '  If Not oForm Is Nothing Then
            '  System.Runtime.InteropServices.Marshal.ReleaseComObject(oForm)
            '  End If
            '   oForm = Nothing

            ' Select the form name in the database window and give focus
            ' to the database window:
            '  oAccess.DoCmd.SelectObject(ObjectType:=Microsoft.Office.Interop.Access.AcObjectType.acForm, ObjectName:=sForm, InDatabaseWindow:=True)

            ' Show the form:
            '   oAccess.DoCmd.OpenForm(FormName:=sForm, View:=Microsoft.Office.Interop.Access.AcFormView.acNormal)

            ' Use Controls collection to edit the form:
            oForm = oAccess.Forms(sForm)
            oCtls = oForm.Controls

            oCtl = oCtls.Item("The Name Of The Control Where The Id Number Is On The Form")
            oCtl.Enabled = True
            ' oCtl.SetFocus()
            NumberExtracted = oCtl.Value
            System.Runtime.InteropServices.Marshal.ReleaseComObject(oCtl)
            oCtl = Nothing

            '  Hide the Database Window:
            '  oAccess.DoCmd.SelectObject(ObjectType:=Microsoft.Office.Interop.Access.AcObjectType.acForm, ObjectName:=sForm, InDatabaseWindow:=True)
            '  oAccess.RunCommand(Command:=Microsoft.Office.Interop.Access.AcCommand.acCmdWindowHide)

            '  Set focus back to the form:
            '  oForm.SetFocus()

            '  Release Controls and Form objects:
            System.Runtime.InteropServices.Marshal.ReleaseComObject(oCtls)
            oCtls = Nothing

            System.Runtime.InteropServices.Marshal.ReleaseComObject(oForm)
            oForm = Nothing

            '  Release Application object and allow Access to be closed by user:
            If Not oAccess.UserControl Then oAccess.UserControl = True
            System.Runtime.InteropServices.Marshal.ReleaseComObject(oAccess)
            oAccess = Nothing


            If NumberExtracted = Nothing Then
                MsgBox("The Number Could Not Be Obtained From The Form" & vbNewLine & vbNewLine & "Please Ensure You Have The Form Open Before Trying To Upload")
                Exit Sub
            End If


            If CheckForDuplicateFolder(SelectedFolderIdent, NumberExtracted + " - ATC") = True Then

                CreatedFolderIdent = GetCreatedFolderID(NumberExtracted + " - ATC", SelectedFolderIdent)
                DriveFilePickerUploader(CreatedFolderIdent)

            Else

                CreateNewDriveFolder(NumberExtracted + " - ATC", SelectedFolderIdent)
                CreatedFolderIdent = GetCreatedFolderID(NumberExtracted + " - ATC", SelectedFolderIdent)
                DriveFilePickerUploader(CreatedFolderIdent)

            End If

        Catch EX As Exception
            MsgBox("The Number Could Not Be Obtained From The Form" & vbNewLine & vbNewLine & "Please Ensure You Have The Form Open Before Trying To Upload" & vbNewLine & vbNewLine & EX.Message)
            Exit Sub
        Finally

            If Not oCtls Is Nothing Then
                System.Runtime.InteropServices.Marshal.ReleaseComObject(oCtls)
                oCtls = Nothing
            End If

            If Not oForm Is Nothing Then
                System.Runtime.InteropServices.Marshal.ReleaseComObject(oForm)
                oForm = Nothing
            End If

            If Not oAccess Is Nothing Then
                System.Runtime.InteropServices.Marshal.ReleaseComObject(oAccess)
                oAccess = Nothing
            End If

        End Try

        End

    End Sub

Check For Duplicate Folders In The Destination Upload Folder

检查目标上传文件夹中的重复文件夹

Public Function CheckForDuplicateFolder(ByVal FolderID As String, ByVal NewFolderNameToCheck As String) As Boolean

    Dim ResultToReturn As Boolean = False

    Try
        Dim request = Service.Files.List()

        Dim requeststring As String = ("'" & FolderID & "' in parents And mimeType='application/vnd.google-apps.folder' And trashed=false")

        request.Q = requeststring

        Dim FileList = request.Execute()

        For Each File In FileList.Items

            If File.Title = NewFolderNameToCheck Then
                ResultToReturn = True
            End If

        Next

    Catch EX As Exception
        MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
    End Try

    Return ResultToReturn

End Function

Create New Drive Folder

创建新的驱动器文件夹

Public Sub CreateNewDriveFolder(ByVal DirectoryName As String, ByVal ParentFolder As String)

    Try

        Dim body1 = New Google.Apis.Drive.v2.Data.File
        body1.Title = DirectoryName
        body1.Description = "Created By Automation"
        body1.MimeType = "application/vnd.google-apps.folder"

        body1.Parents = New List(Of ParentReference)() From {New ParentReference() With {.Id = ParentFolder}}

        Dim file1 As Google.Apis.Drive.v2.Data.File = Service.Files.Insert(body1).Execute()

    Catch EX As Exception
        MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
    End Try

End Sub

Get The Created Folder ID

获取创建的文件夹 ID

    Public Function GetCreatedFolderID(ByVal FolderName As String, ByVal FolderID As String) As String

        Dim ParentFolder As String

        Try

            Dim request = Service.Files.List()

            Dim requeststring As String = ("'" & FolderID & "' in parents And mimeType='application/vnd.google-apps.folder' And title='" & FolderName & "' And trashed=false")

            request.Q = requeststring

            Dim Parent = request.Execute()

            ParentFolder = (Parent.Items(0).Id)

        Catch EX As Exception
            MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
        End Try

        Return ParentFolder

End Function

Drive File Picker Uploader To Upload Files Selected From A File Dialog Box To The Newly Created Folder

Drive File Picker Uploader 将从文件对话框中选择的文件上传到新创建的文件夹

    Public Sub DriveFilePickerUploader(ByVal ParentFolderID As String)

        Try

            ProgressBar1.Value = 0

            Dim MimeTypeToUse As String

            Dim dr As DialogResult = Me.OpenFileDialog1.ShowDialog()

            If (dr = System.Windows.Forms.DialogResult.OK) Then
                Dim file As String

            Else : Exit Sub

            End If

            Dim i As Integer = 0

            For Each file In OpenFileDialog1.FileNames

                MimeTypeToUse = GetMimeType(file)

                Dim filetitle As String = (OpenFileDialog1.SafeFileNames(i))

                Dim body2 = New Google.Apis.Drive.v2.Data.File

                body2.Title = filetitle
                body2.Description = "J-T Auto File Uploader"
                body2.MimeType = MimeTypeToUse

                body2.Parents = New List(Of ParentReference)() From {New ParentReference() With {.Id = ParentFolderID}}

                Dim byteArray = System.IO.File.ReadAllBytes(file)
                Dim stream = New System.IO.MemoryStream(byteArray)

                Dim request2 = Service.Files.Insert(body2, stream, MimeTypeToUse)
                request2.Upload()

            Next

    Catch EX As Exception
        MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
    End Try

End Sub

Get The Mime Type Of The Files Being Uploaded

获取正在上传的文件的 Mime 类型

Public Shared Function GetMimeType(ByVal file As String) As String
        Dim mime As String = Nothing
        Dim MaxContent As Integer = CInt(New FileInfo(file).Length)
        If MaxContent > 4096 Then
            MaxContent = 4096
        End If

        Dim fs As New FileStream(file, FileMode.Open)

        Dim buf(MaxContent) As Byte
        fs.Read(buf, 0, MaxContent)
        fs.Close()
        Dim result As Integer = FindMimeFromData(IntPtr.Zero, file, buf, MaxContent, Nothing, 0, mime, 0)

        Return mime
    End Function


    <DllImport("urlmon.dll", CharSet:=CharSet.Auto)> _
    Private Shared Function FindMimeFromData( _
            ByVal pBC As IntPtr, _
             <MarshalAs(UnmanagedType.LPWStr)> _
             ByVal pwzUrl As String, _
             <MarshalAs(UnmanagedType.LPArray, ArraySubType:=UnmanagedType.I1, SizeParamIndex:=3)> ByVal _
             pBuffer As Byte(), _
             ByVal cbSize As Integer, _
             <MarshalAs(UnmanagedType.LPWStr)> _
             ByVal pwzMimeProposed As String, _
             ByVal dwMimeFlags As Integer, _
             <MarshalAs(UnmanagedType.LPWStr)> _
            ByRef ppwzMimeOut As String, _
             ByVal dwReserved As Integer) As Integer
    End Function

Hopefully this helps you make a start I am 100% convinced this is achievable as I have already done this for my manager.

希望这能帮助你开始我 100% 相信这是可以实现的，因为我已经为我的经理做过这件事。

回答by ??ng ?ình Ng?c

This reply might be late but just wanna share one of the approach! I have done this successfully with VBA and the demo link is here http://www.sfdp.net/thuthuataccess/demo/democAuth.rar?attredirects=0&d=1With this, you can upload, download or delete a file with your GoogleDrive in Access.. Just Wininet + WinHTTP enough Dang Dinh ngoc Vietnam

这个回复可能会迟到，但只是想分享其中一种方法！我已经用 VBA 成功完成了这个，演示链接在这里 http://www.sfdp.net/thuthuataccess/demo/democAuth.rar?attredirects=0&d=1有了这个，你可以上传、下载或删除文件GoogleDrive in Access.. 只要 Wininet + WinHTTP 就够了 Dang Dinh ngoc 越南