上传到谷歌驱动器使用VBA？ [英] Uploading to Google drive using VBA?

问题描述

我现在要求我'附加'的文件给它一个MS Access数据库。我的目的是存储在谷歌驱动器的文件，有一个链接的数据库供用户检索的文件。

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.

由于有过不同的城市很多用户•$ P $垫，这是不实际的要求他们已同步谷歌云端硬盘文件夹。所有的用户将会需要上传到数据库中的能力/ GD所以我的目的是为了有一个单独的谷歌帐户数据库 - 它自己的登录信息

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.

例如：
用户点击按钮来上传文件
另存为对话框出现，用户选择文件
数据库日志到其谷歌驱动器和上传选择的文件

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

与此问题虽然很多，其中最主要的，谷歌驱动器不支持VBA。
如果用户登录到自己的Gmail帐户，这将可能是另外一个问题。

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.

我碰到这个code来抓另一个网站vb.net。

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

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

有人建议将IE库可以利用登录到谷歌驱动器并在上面做上传的API调用。我不知道如何做到这一点。别的地方有人提到了COM包装可能是合适的。我没有比VBA（自学）其他任何编码经验，所以我在努力了解下一步应该是什么。

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.

如果任何人做过类似的东西，也可以提供任何意见，我将不胜感激听到你的声音。

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

推荐答案

这线程现在可能是死的，但如果你和你的数据库的形式工作，用户需要将文件附加到表单中显示的特定记录有唯一的识别号码，然后这绝对是可能的，但你必须做它在.NET编写的外部应用程序，我可以为你提供必要的code，让你开始，vb.net是非常相似的VBA。

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.

什么你需要做的就是创建一个Windows窗体项目，并添加引用到Microsoft Access核心DLL和下载金块包从金块谷歌驱动的API。

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.

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

这code将授权您的驱动器的服务，那么你的进口，可以从任意子或函数可用于再调用你的窗体加载事件这个功能就像

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

=服务GoogleDriveAuth.GetAuthentication

Service = GoogleDriveAuth.GetAuthentication

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

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

然后这块code会看表，您要没有从获得的记录值，并上传文件到您选择的文件夹

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

获取创建的文件夹ID

Get The Created Folder 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

    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

获取的MIME类型的文件在上传

Get The Mime Type Of The Files Being Uploaded

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

希望这有助于你做出一个开始，我100％相信这是可以实现的，因为我已经这样做了我的经理。

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

这篇关于上传到谷歌驱动器使用VBA？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！