VBA를 사용하여 Google 드라이브에 업로드 하시겠습니까?

Question

나는 MS Access 데이터베이스를 사용하여 문서를 첨부해야합니다. 제 의도는 문서를 Google 드라이브에 저장하고 사용자가 문서를 검색 할 수 있도록 데이터베이스에 링크를 만드는 것입니다.

다른 도시로 퍼지는 사용자가 많기 때문에 Google 드라이브 폴더를 동기화하도록 요구하는 것은 실용적이지 않습니다. 모든 사용자는 데이터베이스/GD에 업로드 할 수있는 기능이 필요합니다. 따라서 내 로그인 정보와 함께 데이터베이스에 대한 별도의 Google 계정을 갖게됩니다.

예 : 대화 상자가 나타납니다 및 사용자가,하지만이 자사의 Google 드라이브 및 업로드 선택한 파일에 있다는 것을 주 하나를 문제의

제비 파일 데이터베이스 로그를 선택로 사용자는 파일 저장을 업로드 버튼을 클릭 Google 드라이브는 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 래퍼 (wrapper)'가 적합 할 수 있다고 언급되었습니다. VBA (자기 가르침) 이외의 코딩에 대한 경험이 없으므로 다음 단계가 무엇인지 이해해야합니다.

누구나 비슷한 것을했거나 조언을 제공 할 수 있다면 감사드립니다.

Answer 1

이 스레드는 지금 죽었을 수도 있지만 데이터베이스의 양식으로 작업하고 사용자가 고유 한 식별 번호가있는 양식에 표시된 특정 레코드에 파일을 첨부해야하는 경우이 작업은 가능하지만 .NET으로 작성된 외부 응용 프로그램에서해야합니다. 필요한 코드를 제공하여 시작할 수 있도록해야합니다. vb.net은 VBA와 매우 유사합니다.

당신이해야 할 일은 Windows 양식 프로젝트를 만들고 Microsoft Access Core dll에 대한 참조를 추가하고 너겟에서 Google 드라이브 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 

에서 중복 폴더3210

생성 된 폴더 ID를 업로드

새로 만든 폴더

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 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 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 % 확신 할 수 있기를 바랍니다.

Answer 2

이 답변은 늦을 지 모르지만 그 중 하나를 공유하고 싶습니다! 나는 VBA 성공적으로 이런 짓을하고 데모 링크를 업로드, 다운로드 또는 응옥 그냥 WinInet은 + WinHTTP에 충분한 액세스에, Google 드라이브 .. 댕 딘으로 파일을 삭제할 수 있습니다, 여기 베트남

이와 http://www.sfdp.net/thuthuataccess/demo/democAuth.rar?attredirects=0&d=1 입니다