GoogleDrive 'a yüklenen resimlerin linklerini alma işlemi

[Tevfik_Kursun]

Sayın Haluk Hocam,
İlginize çok teşekkür ederim. Zihnimin açılmasını sağladığınız için de ayrıca teşekkür ederim.
Sebebi doğru tahmin etmişim. (Önceki çalışmayı da aynı dosyada yaptığım için olabilir mi?)
Saygılarımla

 

[Haluk]

Goggle Script'lerin ilk defa nasıl çalıştırılacaklarına dair, kişisel blogumda detaylı bilgi sayfası hazırladım..... İhtiyacı olan veya merak edenler aşağıdaki linki inceleyebilir....

Kod anlatılmaz, yazılır...: Google Script'i çalıştırmak ....

Google Sheets ve scripting için Türkçe kaynak... bazı özel konularda Excel VBA örnekleri

excelhaluk.blogspot.com

.

 

[Haluk]

Google Drive üzerindeki bir klasörde bulunan resimlerin linklerini direkt olarak alma şansınız var mı ? Ben bilmiyorum, olduğunu da pek sanmıyorum.

Ama şu yapılabilir....... Bir Google Sheets dosyasında JScript ile linkler Goggle Sheets dosyasına yazılır, lokal bilgisayardaki bir Excel dosyasından bu Google Sheets dosyasına VBA ile bağlantı kurup, linkler Excel'e alınabilir....

.

Konu üzerinde çalışınca, yapılabildiğini buldum.... Kişisel blog'umda Google Drive üzerindeki bir klasör içersinde yer alan dosya isimleri, indirme link'leri, dosya oluşturma zamanı gibi bilgilerin MS Excel'e aktarıldığı yöntemi detaylıca anlattığım aşağıdaki link incelenebilir...

Kod anlatılmaz, yazılır...: Google Drive klasöründeki dosya isimleri ve URL'i MS Excel'e aktarma

Google Sheets ve scripting için Türkçe kaynak... bazı özel konularda Excel VBA örnekleri

excelhaluk.blogspot.com

.

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
İlginize çok teşekkür ederim. Bugün gördün, üzerinde biraz çalıştım. Bir yerde tıkandım. Bunu da umarım normal karşılarsınız.
Link sonucu geldi. Excel'de makro uygulandığında ise Sözdizimi Hatası verdi hata mesajı olarak. Nerede yanlış yapmış olabilirim?
Saygılarımla

 

[Haluk]

Tevfik Bey;

Hatanın oluştuğu yer, eğer sizin 3. resimde sarı ile işaretlenen yerdeyse benim kodlarda sıkıntı yok gibi..... buradan bakınca, bilemedim.

Ama, 2. resimde hata mesajı penceresinin yan tarafından bir kısmı göründüğü kadarıyla siz strURL değişkenini kendi bulduğunuz linkle değiştirmemişiniz, benim orjinal VBA kodundakini kullanmışınız gibi geldi.

Blog'daki makalemde demiştim ki;

Bu iş için, ilk önce "Web App" in URL'ini hazırlıyoruz. Bunun için de, daha önce kopyalayıp bir yerlerde saklamanızı söylediğim URL'i bulup, aşağıda kırmızı ile belirttiğim ilaveyi yaparak, VBA kodunda kullanmak üzere saklıyoruz.

https://script.google.com/macros/s/AKfycb**O9BlXN0xSfg/exec?format=jsonp&callback=getData

Onu değiştirip, tekrar deneyin bence....

.

 

[Haluk]

Yok eğer eğer strURL değişkeninde gerekli değişikliği yaptım diyorsanız, o değişkenin içeriğindeki hayli uzun olan URL'i tarayıcınızın adres çubuğuna yapıştırıp, ekran görüntüsünü paylaşır mısınız?

.

 

[Tevfik_Kursun]

Sayın Haluk Hocam,

Sign in - Google Accounts

script.google.com

URL
Saygılarımla

 

[Haluk]

Tevfik Bey,

Ekli dosyadaki satırı denermisiniz?

.

 

[Tevfik_Kursun]

Sayın Hocam,
Bu hatayı verdi
Saygılarımla

 

[Haluk]

O hata, daha önce bir hata oluştuğu için oluyor...

Kodun çalışmasını "End" tuşuna basıp sonlandırın, sonra tekrar deneyin....

.

 

[Tevfik_Kursun]

Sayın Hocam,
Kapatıp açtım. Şimdi de bu hatayı verdi
Saygılarımla

 

[Haluk]

24 No'lu mesaja eklediğiniz 3. resimdeki yeri mi sarı ile işaretliyor?

.

 

[Tevfik_Kursun]

Sayın Hocam,
Buyrun
Saygılarımla

 

[Haluk]

26 No'lu mesajda dediğimi yapar mısınız?

.

 

[Haluk]

URL'in sonu;

******exec?format=jsonp&callback=getData

olacak şekilde....

.

 

[Haluk]

Tevfik Bey;

VBA kodundaki strURL değişkeninde yer alan ve sonu ******exec?format=jsonp&callback=getData şeklinde biten linki tarayıcınızın adres çubuğuna yapıştırıp, ekran görüntüsünü paylaşır mısınız demiştim.

Bir sıkıntı mı oldu ?

.

 

[Tevfik_Kursun]

Sayın Hocam,
Kusura bakmayın lütfen o saatlerde elektrik kesildi. Az önce geldi. Ben de makinemin başına yeni oturdum.
Saygılarımla

 

[Haluk]

Anlıyorum sorun değil....

Ekran görüntüsüne göre hiçbir sorun gözükmüyor..... Siz kodu bir butona bağlayıp çalıştırıyorsunuz değil mi?

.

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
evet, bir defa da satır satır adımlattırdım. Yine aynı hatayı vermişti
Saygılarımla

 

[Haluk]

Tevfik Bey, sizde "ScriptControl"un neden çalışmadığını anlayamadım ama alternatif çözüm olması için bir "Regular Expressions" metoduyla JSon verilerini ayıklayan bir kod hazırladım.

Denedikten sonra haber verirsiniz...

Not: Kodlardaki "strURL" değişkenine kendinize ait URL'i yazmayı unutmayın....

Sub GetData()
'   Haluk - 04/10/2021
'   sa4truss@gmail.com
'   https://excelhaluk.blogspot.com/
   
    Dim objHTTP As Object, strURL As String, JSonResponse As String
    Dim arrPattern(1 To 3) As String
    Dim regExp As Object, xPattern As Variant
    Dim r As Long, c As Byte
    Dim RetVal As Variant
   
    Range("A1:C" & Rows.Count).ClearContents
    Range("A1:C1") = Array("File Name", "URL", "Last Update")
   
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
   
    strURL = "https://script.google.com/macros/s/AKfycbxCGn5DN2IrwS11w7EeO9TLvrSU9t9VQysHRF9BPLLPAO8Jtjj2djkKkuMO9BlXN0xSfg/exec?format=jsonp&callback=getData"
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send
   
    If objHTTP.ReadyState = 4 And objHTTP.Status = 200 Then
        JSonResponse = objHTTP.responseText
       
        arrPattern(1) = """fileName"":""(.+?)"",""fileURL"":"
        arrPattern(2) = """fileURL"":""(.+?)"",""fileLastUpdated"":"
        arrPattern(3) = """fileLastUpdated"":""(.+?)""}"
       
        Set regExp = CreateObject("VBScript.RegExp")
       
        regExp.ignorecase = True
        regExp.Global = True
           
        For Each xPattern In arrPattern
            regExp.Pattern = xPattern
            r = 1
            c = c + 1
            If regExp.Test(JSonResponse) Then
                For Each RetVal In regExp.Execute(JSonResponse)
                    r = r + 1
                    Cells(r, c) = RetVal.Submatches(0)
                Next
            End If
        Next
        MsgBox "Veriler alındı...", vbInformation
    Else
        MsgBox "Bir sorun oldu, veriler alınamadı...!"
    End If
   
    Set regExp = Nothing
    Set objHTTP = Nothing
    Erase arrPattern
End Sub

.