Çözüldü VBA ile Google Sheets Sayfasında Arama veya Kıyaslama

[RBozkurt]

Merhaba değerli forum üyeleri;

Excel VBA ile Google Sheets üzerinde birtakım kıyaslama yaptırmak istiyorum.
Sayın @Haluk üstadın hazırlamış olduğu bu mesajdaki işlem veriyi excel sayfasına çekiyor, bu veriyi çekip farklı bir kod ile arama işlemi yaptırılır; fakat bu işlemi excelde herhangi bir sayfaya almadan doğrudan arka planda yaptırmak mümkün müdür?
Yerli yabancı kaynaklara göz gezdirdim buna benzer bir makale de bulamadım.


Örneğin dosyanın çalışacağı PC domaini WG1 olsun, Userde rbozkurt olsun. Bunlar sheets dosyasında varsa veya yoksa kombinasyon aşağıdaki gibi.

Örnek:

domain = CreateObject("WScript.Network").userdomain
username = CreateObject("WScript.Network").username

Google Sheet: https://docs.google.com/spreadsheets/d/1226fFMM7zzGshZax_O9Lq7iUWaHND7Gqfur_Gp-J-ns/edit?usp=sharing

A2:A sütununda domain var, B2:B sütununda username yoksa msgbox "Domain Var, User Yok",
A2:A sütununda domain var, B2:B sütununda username varsa msgbox "Domain Var, User Var",
A2:A sütununda domain yoksa msgbox "Domain Yok"

Sheet dosyası şart değil aslında, yüklenebilecek bir mdb veya sql ile de olur.

 

[RBozkurt]

.

Sub checkRA()
'Google Sheets sayfasında aranan 2 değere göre sonuç çevirir.
'Microsoft XML, v6.0 kütüphaneye eklemeyi unutmayın.
'RBozkurt 05.03.2023

    Dim domain As String
    Dim username As String
    
    ' WScript.Network'ten domain ve kullanıcı adını alın
    domain = CreateObject("WScript.Network").UserDomain
    username = CreateObject("WScript.Network").username
    
    ' Erişilecek Google Sheet'in ID'sini belirleyin
    Dim spreadsheetID As String
    spreadsheetID = "xxx" 'ID No
    
    ' Erişilecek sayfanın adını belirleyin
    Dim sheetName As String
    sheetName = "lisansRA"
    
    ' Erişilecek hücre aralığını belirleyin
    Dim range As String
    range = "A2:B"
    
    ' API URL'sini belirleyin
    Dim url As String
    url = "https://sheets.googleapis.com/v4/spreadsheets/" & spreadsheetID & "/values/" & sheetName & "!" & range
    
    ' API anahtarını belirleyin
    Dim apiKey As String
    apiKey = "xxx" ' API ANAHTARINIZ
    
    ' İsteği Google Sheets API'sine gönderin
    Dim xmlhttp As New MSXML2.XMLHTTP60
    xmlhttp.Open "GET", url & "?key=" & apiKey, False
    xmlhttp.send
    
    ' Google Sheets API'sinden gelen yanıtı ayrıştırın
    Dim response As String
    response = xmlhttp.responseText
    
    ' Domain ve kullanıcı adının sayfada olup olmadığını kontrol edin
    If InStr(response, domain) > 0 Then
        If InStr(response, username) > 0 Then
            MsgBox "Domain Var, User Var"
        Else
            MsgBox "Domain Var, User Yok"
        End If
    Else
        MsgBox "Yetki Yok"
    End If
    
End Sub

 

[Haluk]

Geri dönen JSon tablosu ayrıştırılsa, daha fonksiyonel olurmuş. Ama, Excel 64 Bit için JSon işleri biraz daha meşakkatli.

Bu arada....... API anahtarının kullanımında sınır var mı acaba? (Kullanım adedi açısından günlük-aylık-yıllık)

.

 

[RBozkurt]

Geri dönen JSon tablosu ayrıştırılsa, daha fonksiyonel olurmuş. Ama, Excel 64 Bit için JSon işleri biraz daha meşakkatli.

Bu arada....... API anahtarının kullanımında sınır var mı acaba? (Kullanım adedi açısından günlük-aylık-yıllık)

.

Haluk abi sınır varmı bilmiyorum anahtarı google konsol sisteminden aldım.
Kodda dolu olup olmadığı şeklindeymiş arama yaptırmam lazım.

Sınırı nasıl öğrenirim onuda bulamadım.

 

[RBozkurt]

Tekrar kontrol ettim, hata gözükmüyor.
API'nin önüne geçmek için veri çekilebilecek farklı bir platforma yüklenebilir. Belki OneDrive denemek lazım.

 

[Haluk]

Tamam, çok da önemli değil ..... Benim aklımda sanki bir sınırlama varmış gibi kalmıştı, onun için sormuştum.

Muhtemelen API anahtarı kullanmadan da yapılır..... ama o zaman Goggle Sheets tarafında da bir script gerekir.

Not: Ben bir hatadan bahsetmemiştim ??

.

 

[RBozkurt]

Tamam, çok da önemli değil ..... Benim aklımda sanki bir sınırlama varmış gibi kalmıştı, onun için sormuştum.

Muhtemelen API anahtarı kullanmadan da yapılır..... ama o zaman Goggle Sheets tarafında da bir script gerekir.

Not: Ben bir hatadan bahsetmemiştim ??

.

Aklımda birkaç soru işareti kalmıştı, ben hata var diye düşündüm. Tam olarak deneme yapmamıştım. Bir kaç farklı kombinasyonla denedim hataya rastlamadım. Onedrive deneyeceğim birde.

 

[Haluk]

Alternatif olarak, Google Sheets'deki veriler script kullanarak XML olarak yayınlanır. Daha sonra VBA ile XML tablosu sorgulanır.

Script ile hazırlanarak, yayınlanmış örnek XML tablosu aşağıdaki linktedir;

https://script.google.com/macros/s/AKfycbwUuyiY1GnipNEXbnYNWJb_xJWxLvr9LksZWyoh2QSIpD6YGFby67NCS5uIlR2UgRHhIw/exec

.

 

[RBozkurt]

Onedrive denedim maalesef api istemi orada da bulunuyor. Txt denedim, download gerekiyor.

Bu şekilde olursa api kodu olmadan iş görür.

 

[Haluk]

Script ve VBA için yardıma ihtiyacınız varsa, buradan haber verirsiniz.

.

 

[RBozkurt]

Script ve VBA için yardıma ihtiyacınız varsa, buradan haber verirsiniz.

.

Teşekkürler abi sağolasın. Mesai saati içinde google servislerine erişemiyorum yasaklı maalesef.. Akşam boş oldukça bakabileceğim artık.

 

[Haluk]

Kurcalamak isterseniz belki diye, Google Sheets'de kullandığım JScript kodlarını ve Excel'de kullandığım VBA kodlarını buraya ekliyorum;

Google Sheets'de "Data" sayfası şu şekilde;






Google Sheets için script:

function doGet(request){
  var ss = SpreadsheetApp.getActive().getSheetByName("Data");

  values = ss.getRange("A1:B").getValues().filter(array => array[0] != '');

  values.shift(); //sutun basliklarini iptal et
  var domains = [];

  values.forEach(function(value) {
    var domain = {};
    domain.domainName    = value[0];
    domain.userName    = value[1];
 
    domains.push(domain);
  })
   
  data = XmlService.createElement('Data')
        .setAttribute('Title','Domain ve Kullanıcı listesi');

  source = XmlService.createElement('XML_Source')
           .setText('XML tablosu Google Script ile hazırlanmıştır');

  data.addContent(source);

  coder = XmlService.createElement('Coder')
           .setText('Haluk - 05/03/2023');

  data.addContent(coder);

  domains_data = XmlService.createElement('Domains');

  data.addContent(domains_data);

  domains.forEach(domain => {
    child = XmlService.createElement('Data');

    children1 = XmlService.createElement('DomainName')
               .setText((domain.domainName));
    child.addContent(children1);

    children2 = XmlService.createElement('UserName')
               .setText(domain.userName);
    child.addContent(children2);
 
    domains_data.addContent(child);
  });

  document = XmlService.createDocument(data);
  xml = XmlService.getPrettyFormat()
        .setEncoding('UTF-8')
        .format(document);

  var paramCallback = request.parameter.callback;
  //return ContentService.createTextOutput(paramCallback+'(' + xml + ')').setMimeType(ContentService.MimeType.TEXT);
  // Kullanim sekli;
  // scriptURL/exec?callback=getData

  // Excel VBA'de XML tablosunu import etmek icin, callback kullanmadan yayinlamak daha kolaylık saglar
  return ContentService.createTextOutput( xml ).setMimeType(ContentService.MimeType.TEXT);
  // Kullanim sekli;
  // scriptURL/exec

}

Excel VBA kodları;

Sub Test()
'   Haluk - 05/03/2023
'   sa4truss@gmail.com

    Dim objHTTP As Object, strURL As String, strXML As Variant
    Dim i As Long
    Dim XDoc As Object, myList As Object

    Range("A1:B1") = Array("Domain Name", "User Name")
    Range("A2:B" & Rows.Count).ClearContents

    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    strURL = "https://script.google.com/macros/s/AKfycbwUuyiY1GnipNEXbnYNWJb_xJWxLvr9LksZWyoh2QSIpD6YGFby67NCS5uIlR2UgRHhIw/exec"

    objHTTP.Open "GET", strURL, False
    objHTTP.send
 
    strXML = objHTTP.responseText
 
    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False
    XDoc.validateOnParse = False
 
    If IsObject(strXML) Then
       hDoc = XDoc.Load(strXML)
    Else
       hDoc = XDoc.LoadXML(strXML)
    End If
 
    If hDoc = True And XDoc.parseError = 0 Then
        Set myList = XDoc.SelectNodes("//Domains/Data")
     
        If myList.Length = 0 Then GoTo SafeExit:
     
        For i = 0 To myList.Length - 1
            Range("A" & i + 2) = myList(i).SelectSingleNode("DomainName").Text
            Range("B" & i + 2) = myList(i).SelectSingleNode("UserName").Text
        Next
    Else
        MsgBox "XML dokumaninda problem var!" & vbCrLf & vbCrLf & XDoc.parseError.reason
    End If
 
'   ***********************************************************************************************
'   Web uzerindeki XML tablosundan sorgulama örneği;

    myDomain = "domain4"     ' Bu veri sayfadaki bir hucreden de alinabilir.
 
    MsgBox "XML tablosu Excel'e aktarildi...." & vbCrLf & "Simdi, '" & myDomain & "' Web uzerindeki XML tablosundan sorgulanacak!"
 
    Set myData = XDoc.SelectSingleNode("//Domains/Data[DomainName='" & myDomain & "']/UserName")
 
    If Not myData Is Nothing Then
        Set xDomains = XDoc.SelectNodes("//Domains/Data[DomainName='" & myDomain & "']/UserName")
        MsgBox xDomains.Length & " adet ''" & myDomain & "'' bulundu!"
        For j = 0 To xDomains.Length - 1
            If Len(xDomains(j).Text) = 0 Then
                MsgBox "DomainName = " & myDomain & " icin UserName yok...."
            Else
                MsgBox "DomainName = " & myDomain & " icin bulunan User Name = " & xDomains(j).Text
            End If
        Next
    Else
        MsgBox myDomain & " isimli domain bulunamadı"
    End If
         
SafeExit:
    Set myList = Nothing
    Set XDoc = Nothing
    Set objHTTP = Nothing
End Sub

Yukarıdaki JScript kodunu hazırladıktan sonra, script editörde "Deploy" yapıp (yani yayınlayıp) elde ettiğiniz URL'i VBA kodundaki "strURL" değişkenine yazıyorsunuz.

Script'in doğru bir şekilde çalışıp, çalışmadığını kontrol etmek için elde ettiğiniz URL'i tarayıcınızın adres çubuğuna yazıp ENTER tuşuna basın. Eğer XML tablosunu ekranda görüyorsanız, işler yolunda demektir. O zaman, URL'i dediğim gibi Excel VBA'de "strURL" değişkenine yazıp VBA kodunu çalıştırabilirsiniz.

Benim örnek çalışmada elde ettiğim URL aşağıdadır, tıklayıp XML tablosunu tarayıcınızda görüntüleyebilirsiniz.

https://script.google.com/macros/s/AKfycbwUuyiY1GnipNEXbnYNWJb_xJWxLvr9LksZWyoh2QSIpD6YGFby67NCS5uIlR2UgRHhIw/exec

Tabii, ihtiyacınıza göre VBA kodunu revize edebilirsiniz. Ben örnek olması açısından hem tüm XML tablosunu Excel'e aktardım, hem de bir sorgulama örneği ekledim.

.

 

[veyselemre]

Haluk Bey yine bilginizi konuşturup, paylaşmışsınız. Çok güzel bir örnek olmuş, Yalnız arkadaşın isteğine binaen, google sheetten tüm verileri çekmek yerine, api server gibi bir çözüm de olabilirdi. Yani scripte parametre ile domain ve UserName mi gönderip sonucunda sadece true/false döndürseydi, arkadaş xml parse etmeye uğraşmazdı.

 

[Haluk]

Eyvallah, teşekkürler Veysel Bey.

Bir ara, belirttiğiniz gibi bir çalışma da hazırlarım.... o da iyi olur.

.

 

[Haluk]

Haluk Bey yine bilginizi konuşturup, paylaşmışsınız. Çok güzel bir örnek olmuş, Yalnız arkadaşın isteğine binaen, google sheetten tüm verileri çekmek yerine, api server gibi bir çözüm de olabilirdi. Yani scripte parametre ile domain ve UserName mi gönderip sonucunda sadece true/false döndürseydi, arkadaş xml parse etmeye uğraşmazdı.

İlk mesajda belirtildiği gibi;

- "Domain Var, User Yok"
- "Domain Var, User Var"
- "Domain Yok"


cevap seçeneklerin, Google Sheets'de sorgulama yapılarak sonucun Excel'e aktarılması için bir çalışma yaptım. Yani, Excel VBA sadece parametreyi gönderip, sonucu okumak için çalışıyor. Diğer bütün işler Google Sheets'de script tarafından yapılmaktadır.

Google Sheets'de "Data" isimli sayfa içeriği, aşağıdaki resimde belirtildiği gibidir;






Bu çalışmanın ana fikri; sunucuya yani Google Sheets'e bir domain adını parametre olarak POST edip, sonucu GET metoduyla almaktır.

Buna yönelik olarak Google Sheets tarafında hazırladığım script ve Excel tarafındaki VBA kodu aşağıda verilmiştir;

Google Sheets için script;

var scriptProp = PropertiesService.getScriptProperties();

function doPost(request){
  var lock = LockService.getScriptLock();
  lock.waitLock(10000);

  var xDomain=request.parameter.domain;
  scriptProp.setProperty('key', xDomain);
}

function doGet(e){
  var ss = SpreadsheetApp.getActive().getSheetByName("Data");
  var qDomain = scriptProp.getProperty('key') ;

  values = ss.getRange("A1:B").getValues().filter(array => array[0] != '');

  values.shift();

  var myArr    = values.map(x => {return (x[0] == qDomain  ) ? x : '' }).filter(String);

  if(myArr.length > 0) {
    // Domain bulundu.....
    if (myArr[0][1].length > 0) {
      // retVal = 'User Name bulundu >>> ' + myArr[0][1]
      retVal = 'Domain var, UserName var'
    }
    else if (myArr[0][1].length == 0){
    retVal = 'Domain var, UserName yok'
   //   retVal = false
    }
  }
  else {
    retVal = 'Domain yok'
  };

  Logger.log(retVal);

  return ContentService.createTextOutput(retVal).setMimeType(ContentService.MimeType.TEXT);
  // Kullanim sekli;
  // scriptURL/exec
}

Excel VBA kodu;

Sub TestQuery()
    'Haluk - 07/03/2023
    'https://excelhaluk.blogspot.com
 
    Dim NoA As Long, i As Long, URL As String, objHTTP As Object
    Dim varArg1 As Variant, varArg2 As Variant, varArguments As Variant
 
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
 
    strURL = "https://script.google.com/macros/s/AKfycbw44n_KukRvlxXaNsJmevQHBkJ4EbzCH6kR6feNTHQDF-pqP_0QU5DnYWbtwhrN64g/exec"

    xDomain = "domain98"     ' Bu veri sayfada bir hucreden alınabilir.
 
    varArg1 = URL_Encode(xDomain)

    varArguments = "domain=" & varArg1

    objHTTP.Open "POST", strURL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"

    objHTTP.send varArguments

    If objHTTP.Status <> 200 Then
        MsgBox "Hata oluştu...." & vbCrLf & "Sunucu kodu: " & objHTTP.Status
        GoTo safeExit:
    End If
 
    objHTTP.Open "GET", strURL, False
    objHTTP.send
 
    strRetVal = objHTTP.responseText
 
    MsgBox strRetVal

safeExit:
    Set objHTTP = Nothing
End Sub
'
Function URL_Encode(strText)
    'Zeki Gürsoy - 10/01/2021
    'https://zekigursoy.blogspot.com
 
    Dim objHtmlfile As Object
 
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("HTMLFILE")
        objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s);}", "jscript"
    End If
 
    URL_Encode = objHtmlfile.parentWindow.encode(strText)
End Function

 

[RBozkurt]

Eline sağlık @Haluk abi kodlar için teşekkürler.

Bu uygulamanın kullanım amacı iş amacıyla hazırlamış olduğum programı kontrol edebilmekti. Bazı egosu yüksek şahısların kullanımını istemiyorum.
Aslında giriş ekranına PC kullanıcı adı ve şifre doğrulaması ekledim; fakat bu seferde dosyaya erişen herkes kendi oturumunda kullanıcı adı ve şifresini girerek açabilecekti.

Sonra bu şekilde domain ve kullanıcı adına izin verirsem Giriş ekranı da buna göre rol çevirecekti.
MsgBox işlevi işin test yolu. Anlamak için kod bloğuna bunu ekledim. En son stabil durumda o mesaj kısımlarına makro kodlarını ekleyeceğim.

Şuan #2. mesajda paylaştığım kod bloğu bu işlemi yapıyor. Hem veriyi excele çekmiyor hem gerekli sorguyu yapıyor. Uygulamayı revize yapmadım daha.

Senin #12. mesajdaki yöntemde API işlemi iptal edilip VBA'da aynı şekilde veriyi excelde biryere kaydetmeden kıyaslamayı sonuçlandırırsam daha mantıklı olabilir.

#15. mesajı ayrıca denemem lazım okudum ama anlayamadım.

 

[Haluk]

#15. mesajı ayrıca denemem lazım okudum ama anlayamadım.

Anlaşılmayacak bir şey yok aslında.....

Google Sheets'deki veriler Excel'e aktarılmıyor. Sadece sonuç bilgisi "Domain Yok", "Domain Var, UserName Var/Yok" şeklinde bilgi geliyor.

Denemek için sadece VBA kodunu boş bir Excel dosyasında çalıştırabilir ve benim Drive üzerindeki verileri sorgulayabilirsin.

Diğer yandan; 12. mesajdaki kodda da istersen verileri Excel'i aktarmayabilirsin. Kodu, neler yapılabileceğini göstermek adına geniş tuttum. O kodun içindeki sorgulama bölümünde yazdığım gibi sorgulama Excel'e aktarılan veriler üzerinde değil, Web'de yayınlanan XML tablosu üzerinden yapılıyor.

.

 

[RBozkurt]

Alternatif olarak, Google Sheets'deki veriler script kullanarak XML olarak yayınlanır. Daha sonra VBA ile XML tablosu sorgulanır.

Script ile hazırlanarak, yayınlanmış örnek XML tablosu aşağıdaki linktedir;

https://script.google.com/macros/s/AKfycbwUuyiY1GnipNEXbnYNWJb_xJWxLvr9LksZWyoh2QSIpD6YGFby67NCS5uIlR2UgRHhIw/exec

.

Bu tabloyu oluşturan adres veri güncellendikçe adreste güncellenme işlemi oluyormudur?
Bu şekilde adrese çevirmeyi bulamadım.

 

[Haluk]

12. mesajda şöyle demiştim;

"Yukarıdaki JScript kodunu hazırladıktan sonra, script editörde "Deploy" yapıp (yani yayınlayıp) elde ettiğiniz URL'i VBA kodundaki "strURL" değişkenine yazıyorsunuz. "

Google Sheets tarafında "script" içinde ne zaman bir değişiklik yaparsanız, mutlaka script'i "Deploy" etmeniz gerekir. Sayfadaki verilerde güncelleme yaptığınızda buna gerek yoktur.

Tekrar belirtmek istiyorum; siz 15.mesajdaki VBA kodunu olduğu gibi kopyalayıp, Excel'de deneyin...... İşinize yararsa ondan sonra JScript koduyla uğraşırsınız. 15. mesaj, sizin ilk mesajınızda bahsettiğiniz işleri aynen yapmaktadır.

.

 

[RBozkurt]

Dağıtım yöntemini bulamadım; login gerekiyor.