Access Dosya Güncelleme İnternetten Dropbox Ve Google Drive

1 2 3 4
12/03/2020, 00:40

feraz

(12/03/2020, 00:16)ozanakkaya yazdı: 2 Mb'den büyük gif yükleyemezsiniz.

(11/03/2020, 14:21)ozanakkaya yazdı: Dropbox ve Google Drive linklerini ayrı ayrı deneyerek test edin.

Üstteki cümleden ne anlıyorsunuz? Niye linkleri dropbox veya google drive linkleri ile değiştirmiyorsunuz. Önce ayar yapılır, uygulama sonra test edilir.

Önceki mesajımdaki örnek yenilenmiştir.
Gif olayını biliyorum 2mb sınırını.Önceden harici siteye gif ekleyip url sini yapıştırınca gif piyasaya çıkıyordu şimdi olmuyor.
Alıntı yaptığınız olay ise zaten gifi izlediyseniz denemek için dropboxtta denedim .
Önceden yazmıştınız linkleri olduğu gibi kopyalayın kendisi convert(değiştirir) diye.Nerde yanlışlık yaptım bende bilmiyorum.Tekrar deneyeceğim.
12/03/2020, 01:07

ozanakkaya

frm_hesapla isimli formdaki VersiyonNedir kodunun tamamını aşağıdaki ile değiştirerek deneyiniz.

Public Sub VersiyonNedir()
Dim versiyon_adresi As String
Dim temp, strLineInput As String
Dim fieldname As String
Dim GProgVer As String
Dim GVersiyon, GGuncelleDosyasiUrl, GYeniSurumUrl, GGuncelleDosyaAdi, GYeniSurumAdi As String
Dim sim_major_vers, sim_midi_vers, sim_minor_vers, gun_major_vers, gun_midi_vers, gun_minor_vers As Byte
Dim db As DAO.Database
Dim strSQL As String
Dim strTableName, GDosyaDizin, GEskiDosya, GYeniDosya, GProgVerLink As String
Dim FileNum As Integer
Dim accapp As Access.Application


GProgVer = Environ("TEMP") & "\progver.txt"
GYeniSurumUrl = Dlookup ("yenidosyaurl", "tbl_uygulama_ayarlari")
GYeniSurumAdi = Dlookup ("yenidosyaadi", "tbl_uygulama_ayarlari")
GGuncelleDosyasiUrl = Dlookup ("guncellemedosyasiurl", "tbl_uygulama_ayarlari")
GGuncelleDosyaAdi = Dlookup ("guncellemedosyasiadi", "tbl_uygulama_ayarlari")


DeleteUrlCacheEntry GYeniSurumUrl
DeleteUrlCacheEntry GGuncelleDosyasiUrl
   
    If Len(Dir(Environ("TEMP") & "\" & GGuncelleDosyaAdi)) > 0 Then
        Kill Environ("TEMP") & "\" & GGuncelleDosyaAdi
    End If
   
    If Len(Dir(GProgVer)) > 0 Then
        Kill GProgVer
    End If
   
    versiyon_adresi = Dlookup ("versiyonkontrolurl", "tbl_uygulama_ayarlari")
   
  If InStrRev(versiyon_adresi, "drive.google.com") > 0 Then

    If Len(MetinVeriBul(versiyon_adresi, "/d/", "/view")) > 0 Then
   
        GProgVerLink = "https://drive.google.com/uc?export=download&id=" & MetinVeriBul(versiyon_adresi, "/d/", "/view")
     
    End If
   
   
ElseIf InStrRev(versiyon_adresi, "dropbox.com") > 0 Then

    GProgVerLink = "https://dl.dropboxusercontent.com/" & Mid(versiyon_adresi, InStr(1, versiyon_adresi, "dropbox.com") + 12)
                 
Else

    GProgVerLink = versiyon_adresi
       
End If
     
    URLDownloadToFile 0, GProgVerLink, GProgVer, 0, 0
       
    lbl_programin_versiyonu.Caption = Nz(DLookup("uygulama_versiyonu", "tbl_uygulama_ayarlari"), "0.0.00")
               
    If Len(Dir(GProgVer)) = 0 Then
    lbl_guncel_versiyon.Caption = ""
    MsgBox GProgVer & vbNewLine & vbNewLine & "Dosyasi Bulunamadi...", vbCritical, "Hata"
    Exit Sub
    End If
             
             
   
    FileNum = FreeFile()
    Open GProgVer For Input As #FileNum
   
    Do While Not EOF(FileNum)
    Line Input #FileNum, strLineInput
    temp = strLineInput
    Loop
    Close #FileNum
   
    If InStrRev(temp, "versiyon:") > 0 Then
       
    GVersiyon = Mid$(temp, InStr(temp, ":") + 1, 6)
       
    Else
       
    MsgBox "Versiyon Dosyası Hatalı. Lütfen dosya linkini kontrol ediniz."
    Exit Sub
       
    End If
         

    sim_major_vers = Mid$(lbl_programin_versiyonu.Caption, 1, 1)
    sim_midi_vers = Mid$(lbl_programin_versiyonu.Caption, 3, 1)
    sim_minor_vers = Mid$(lbl_programin_versiyonu.Caption, 5, 2)
   
   
    gun_major_vers = Mid$(GVersiyon, 1, 1)
    gun_midi_vers = Mid$(GVersiyon, 3, 1)
    gun_minor_vers = Mid$(GVersiyon, 5, 2)
   
    If IsNull(gun_major_vers) And IsNull(gun_midi_vers) And IsNull(gun_minor_vers) Then
   
    Exit Sub
    End If
   
    lbl_guncel_versiyon.Caption = GVersiyon
   
    If gun_major_vers > sim_major_vers Then
   
        lbl_guncel_versiyon.ForeColor = RGB(255, 0, 0)
       
        If MsgBox("A Kullandığınız programdan daha yeni bir versiyon bulunmaktadır." & vbCrLf & vbCrLf & "Yeni versiyonu indirmek istiyor musunuz?", vbExclamation + vbYesNo, "Yeni Sürüm Mevcut") = vbYes Then
       
           
            URLDownloadToFile 0, GYeniSurumUrl, Environ("TEMP") & "\" & GYeniSurumAdi, 0, 0
            URLDownloadToFile 0, GGuncelleDosyasiUrl, Environ("TEMP") & "\" & GGuncelleDosyaAdi, 0, 0
           
        End If
       
    ElseIf gun_midi_vers > sim_midi_vers Then
   
        lbl_guncel_versiyon.ForeColor = RGB(255, 0, 0)
       
        If MsgBox("B Kullandığınız programdan daha yeni bir versiyon bulunmaktadır." & vbCrLf & vbCrLf & "Yeni versiyonu indirmek istiyor musunuz?", vbExclamation + vbYesNo, "Yeni Sürüm Mevcut") = vbYes Then
       
            URLDownloadToFile 0, GYeniSurumUrl, Environ("TEMP") & "\" & GYeniSurumAdi, 0, 0
            URLDownloadToFile 0, GGuncelleDosyasiUrl, Environ("TEMP") & "\" & GGuncelleDosyaAdi, 0, 0
           
        End If
       
    ElseIf gun_minor_vers > sim_minor_vers Then
   
        lbl_guncel_versiyon.ForeColor = RGB(255, 0, 0)
       
        If MsgBox("C Kullandığınız programdan daha yeni bir versiyon bulunmaktadır." & vbCrLf & vbCrLf & "Yeni versiyonu indirmek istiyor musunuz?", vbExclamation + vbYesNo, "Yeni Sürüm Mevcut") = vbYes Then
       
            URLDownloadToFile 0, GYeniSurumUrl, Environ("TEMP") & "\" & GYeniSurumAdi, 0, 0
            URLDownloadToFile 0, GGuncelleDosyasiUrl, Environ("TEMP") & "\" & GGuncelleDosyaAdi, 0, 0

            GDosyaDizin = CurrentProject.Path & "\"
            GEskiDosya = Dlookup ("uygulamaadi", "tbl_uygulama_ayarlari")
            GYeniDosya = Dlookup ("yenidosyaadi", "tbl_uygulama_ayarlari")
           
            Set db = OpenDatabase(Environ("TEMP") & "\" & GGuncelleDosyaAdi)
           
            db.Execute "Delete * FROM tbl_guncellemeayar;"
            db.Execute "INSERT INTO tbl_guncellemeayar (dosyadizin, eskidosyaadi,yenidosyaadi) VALUES ('" & GDosyaDizin & "', '" & GEskiDosya & "', '" & GYeniDosya & "');"
            db.Close
           
 

            Set accapp = New Access.Application

            accapp.OpenCurrentDatabase Environ("TEMP") & "\" & GGuncelleDosyaAdi

          Application.Quit
   
        End If
       
    Else
   
        'MsgBox "Şu anda en son güncel versiyonu kullanıyorsunuz", vbInformation + vbOKOnly, ProgramAdi
        lbl_guncel_versiyon.ForeColor = RGB(0, 0, 0)
   
    End If
       
   
End Sub
12/03/2020, 01:28

feraz

Ozan hocam önceki gifteki url leri aynı bıraktım dropbox için ve son verdiğiniz kodu yapıştırdım.
En alttaki gibi hata oluştu.







12/03/2020, 01:31

ozanakkaya

Bu internetten dosya güncelleme mevsuzu ile ilgili son cevabım. 4. mesajdaki örneği deneyiniz.
12/03/2020, 01:41

feraz

(12/03/2020, 01:31)ozanakkaya yazdı: Bu internetten dosya güncelleme mevsuzu ile ilgili son cevabım. 4. mesajdaki örneği deneyiniz.
Daha kaç defa inceleyeceğim abey
Şuna bir video çeksenizde anyabilsek mevzuyu yoksa kafa basmıyor yada bilmiyorum neden olmuyor her denileni yapmam rağmen.

Hiç olmadı ilk mesajdaki dosya zaten çalışıyor.Ben anladım sizin nasıl yapmak istediğiniz olayı url lerin değiştirilmesi için.
Yani dropbox ve Drive de kalığ var  https://drive.google.com/uc?export=download&id ve https://dl.dropboxusercontent.com/s gibi olmadı bende yapabilirim sanırım.
12/03/2020, 01:44

ozanakkaya

(12/03/2020, 01:31)ozanakkaya yazdı: Bu internetten dosya güncelleme mevsuzu ile ilgili son cevabım. 4. mesajdaki örneği deneyiniz.

Bu mesajdan sonra, 4. mesajdaki örneği indirip denediniz mi? Almancam yok ama eklediğin resimde "Sub veya Fonksiyon Bulunamadı" yazdığını anlayabiliyorum.
1 2 3 4