我有一个MS Access数据库，现在要求我“附加”文档。我的目的是将文档存储在Google云端硬盘上，并在数据库上有一个链接供用户检索文档。
由于有许多用户遍布不同的城市，要求他们同步Google云端硬盘文件夹是不切实际的。所有用户都需要能够上传到数据库/ GD，因此我的目的是为数据库建立一个单独的Google帐户 - 具有自己的登录详细信息。
例如： 用户单击按钮上传文件 出现另存为对话框，用户选择文件 数据库会记录到其Google云端硬盘并上传所选文件
很多问题，主要是Google Drive不支持VBA。 如果用户登录了自己的Gmail帐户，则可能是另一个问题。
我在另一个网站上看到了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
有人建议可以利用IE库登录Google云端硬盘，并通过上面的API调用进行上传。我不知道该怎么做。在其他地方，有人提到“COM包装器”可能是合适的。我没有VBA以外的任何编码经验（自学成才），所以我很难理解下一步应该是什么。
如果有人做过类似的事情或提出任何建议，我将很高兴收到你的来信。
答案 0 :(得分：3)
这个帖子现在可能已经死了，但是如果您正在使用数据库中的表单并且用户需要将文件附加到具有唯一标识号的表单中显示的特定记录，那么这肯定是可能的，但您可能会有在用.NET编写的外部应用程序中执行此操作我可以为您提供必要的代码以帮助您入门，vb.net与VBA非常相似。
您需要做的是创建一个Windows窗体项目并添加对Microsoft access core dll的引用，并从nugget下载google drive api的块包。
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
此代码将授权您的驱动器服务，然后您在导入下创建一个公共共享服务作为DriveService，可以在任何子或函数中使用，然后在表单加载事件上调用此函数，如
服务= GoogleDriveAuth.GetAuthentication
将项目引用添加到Microsoft Access 12.0对象库或您拥有的任何版本
然后这段代码将查看您想要获取记录的值的表单，并将文件上传到您选择的文件夹
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
检查目标上载文件夹中的重复文件夹
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
创建新的云端硬盘文件夹
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
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
驱动文件选取器上传器将从文件对话框中选择的文件上传到新创建的文件夹
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类型
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％确信这是可以实现的，因为我已经为我的经理做过这样的事。
答案 1 :(得分：1)
这个回复可能会迟到，但只想分享其中一种做法！ 我用VBA成功完成了这个，演示链接就在这里 http://www.sfdp.net/thuthuataccess/demo/democAuth.rar?attredirects=0&d=1 有了这个，您可以在Access中使用GoogleDrive上传，下载或删除文件。 只需Wininet + WinHTTP就够了 Dang Dinh ngoc 越南