Excelden GoogleDrive'a

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Excel ile oluşturulmuş txt dosyasını makro ile GoogleDrive'da belli bir klasöre yüklemek, ya da, Excelde txt yapılan alan içindeki dataları, yine makro ile GooglrDrive'da hazırlanmış ExcelSheet'e yazdırmak istiyorum. Bu konularda çalışması olan arkadaşlarımın ilgi ve önerilerini bekliyorum.
Saygılarımla

 

[pitchoute]

Merhaba, OAuth 2.0 kimlik bilgilerini (Client ID ve Client Secret) aldıktan sonra şu makroyu deneyip sonucu paylaşabilir misiniz;

Option Explicit

Private Const GOOGLE_AUTH_URL As String = "https://accounts.google.com/o/oauth2/auth"
Private Const GOOGLE_TOKEN_URL As String = "https://accounts.google.com/o/oauth2/token"
Private Const REDIRECT_URI As String = "urn:ietf:wg:oauth:2.0:oob"
Private Const SCOPE As String = "https://www.googleapis.com/auth/drive"

Private Const CLIENT_ID As String = "BURAYA_KENDI_CLIENT_IDINIZI_YAZIN"
Private Const CLIENT_SECRET As String = "BURAYA_KENDI_CLIENT_SECRETINIZI_YAZIN"

Public Sub ExceldenTXTYukle()
    Dim txtDosyaYolu As String
    Dim googleKlasorID As String
    
    txtDosyaYolu = ThisWorkbook.Path & "\veri.txt"
    Call ExcelVerisiniTXTyeKaydet(txtDosyaYolu)
  
    googleKlasorID = "BURAYA_GOOGLE_DRIVE_KLASOR_ID_YAZIN"
    
    Call TXTDosyasiniGoogleDriveYukle(txtDosyaYolu, googleKlasorID)
    MsgBox "İşlem tamamlandı. TXT dosyası Google Drive'a yüklendi.", vbInformation
End Sub

Private Sub ExcelVerisiniTXTyeKaydet(dosyaYolu As String)
    Dim ws As Worksheet
    Dim satir As Long, sutun As Long
    Dim satirIcerik As String
    Dim fileNo As Integer
    
    Set ws = ActiveSheet
    fileNo = FreeFile
    
    Open dosyaYolu For Output As #fileNo
 
    For satir = 1 To ws.UsedRange.Rows.Count
        satirIcerik = ""
        For sutun = 1 To ws.UsedRange.Columns.Count
            If sutun > 1 Then satirIcerik = satirIcerik & vbTab
            satirIcerik = satirIcerik & ws.Cells(satir, sutun).Value
        Next sutun
        Print #fileNo, satirIcerik
    Next satir
    
    Close #fileNo
End Sub

Private Function GoogleOAuth2TokenAl() As String
    Dim authURL As String
    Dim tokenResponse As String
    Dim accessToken As String
    
    authURL = GOOGLE_AUTH_URL & "?client_id=" & CLIENT_ID & _
             "&redirect_uri=" & REDIRECT_URI & _
             "&scope=" & SCOPE & _
             "&response_type=code"
    
    Debug.Print "Lütfen şu URL'yi tarayıcıda açın:"
    Debug.Print authURL
    
    Dim authCode As String
    authCode = InputBox("Yetkilendirme URL'sini tarayıcıda açın ve aldığınız kodu buraya yapıştırın:")
    
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    xmlhttp.Open "POST", GOOGLE_TOKEN_URL, False
    xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
    Dim postData As String
    postData = "code=" & authCode & _
              "&client_id=" & CLIENT_ID & _
              "&client_secret=" & CLIENT_SECRET & _
              "&redirect_uri=" & REDIRECT_URI & _
              "&grant_type=authorization_code"
    
    xmlhttp.send postData
    tokenResponse = xmlhttp.responseText
    
    Dim startPos As Long, endPos As Long
    startPos = InStr(tokenResponse, """access_token"":""") + 16
    endPos = InStr(startPos, tokenResponse, """") - 1
    
    accessToken = Mid(tokenResponse, startPos, endPos - startPos + 1)
    GoogleOAuth2TokenAl = accessToken
End Function

Private Sub TXTDosyasiniGoogleDriveYukle(dosyaYolu As String, klasorID As String)
    Dim accessToken As String
    Dim xmlhttp As Object
    Dim dosyaAdi As String
    
    dosyaAdi = Mid(dosyaYolu, InStrRev(dosyaYolu, "\") + 1)
    
    accessToken = GoogleOAuth2TokenAl()
    
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    xmlhttp.Open "POST", "https://www.googleapis.com/upload/drive/v3/files?uploadType=multipart", False
    
    xmlhttp.setRequestHeader "Authorization", "Bearer " & accessToken
    xmlhttp.setRequestHeader "Content-Type", "multipart/related; boundary=boundary"
    
    Dim dosyaIcerik As String
    Dim fileNo As Integer
    fileNo = FreeFile
    
    Open dosyaYolu For Binary As #fileNo
    dosyaIcerik = Space(LOF(fileNo))
    Get #fileNo, , dosyaIcerik
    Close #fileNo
    
    Dim requestBody As String
    requestBody = "--boundary" & vbCrLf & _
                 "Content-Type: application/json" & vbCrLf & vbCrLf & _
                 "{""name"":""" & dosyaAdi & """," & _
                 """parents"":[""" & klasorID & """]}" & vbCrLf & _
                 "--boundary" & vbCrLf & _
                 "Content-Type: text/plain" & vbCrLf & vbCrLf & _
                 dosyaIcerik & vbCrLf & _
                 "--boundary--"
    
    xmlhttp.send requestBody
    
    If xmlhttp.Status = 200 Then
        Debug.Print "Dosya başarıyla yüklendi."
    Else
        Debug.Print "Hata: " & xmlhttp.responseText
    End If
End Sub

 

[Tevfik_Kursun]

Sayın Pitchoute Hocam,
Daha önce nu konu ile ilgilenmediğim için (OAuth 2.0 kimlik bilgilerini (Client ID ve Client Secret)) bu ifadelerin ne olduğu ve nasıl alındığını bilmiyorum.Yardımcı olur musunuz, lütfen?
Saygılarımla

 

[pitchoute]

Hocam şu şekilde ilerlemeniz sağlıklı olacaktır düşüncesindeyim;
Google Cloud Console'da (https://console.cloud.google.com) bir proje oluşturun lütfen. Drive API'yi etkinleştirin sonrasında. OAuth 2.0 kimlik bilgilerini (Client ID ve Client Secret) alabilirsiniz.

 

[Tevfik_Kursun]

Teşekkürler, deneyeceğim.
Saygılarımla

 

[pitchoute]

Saygılar benden, iyi çalışmalar.