En son indirilen exceli makro ile açmak

Salihd46 · 23 Mayıs 2022

arkadaşlar uğraştım yapamadım, olsa büyük kolaylık olacak benim için, normalde makro ile indirilenler klasörünü açıyor oradan seçtiğim exceli açıyor ve programa yüklüyorum, direk en son indirilen exceli otomatik seçip yükleme yapabilir miyiz acaba, yüklenecek excel isimleri İşletme_Raporu, İşletme_Raporu (1), İşletme_Raporu (2).... şeklinde gidiyor, şimdiden teşekkür ederim.

Kod:

 Sub tümEkle()

    Application.ScreenUpdating = False
    Dim strDownloads, Dosyasonu, Kitapadi As String
    Kitapadi = Application.ActiveWorkbook.Name
    strDownloads = Application.GetOpenFilename("xls Files,*.xls,All Files,*.*", 1, "Open File", , False)
    If Len(strDownloads) < 6 Then Exit Sub
    Dosyasonu = Right(strDownloads, Len(strDownloads) - InStrRev(strDownloads, "\"))
    ActiveWorkbook.FollowHyperlink strDownloads
    Range("a1").Select
    If Range("I6").Value <> "İŞLETMEDEKİ SIĞIR-MANDA TÜRÜ HAYVAN BİLGİ RAPORU" Then
        MsgBox ("Lütfen doğru liste seçiniz!"), vbCritical, "Hatalı Liste!"
    Else
        Sheets(1).Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Range("A12:AR" & Rows.Count).ClearContents
    For i = 1 To Sheets.Count
    If Sheets(i).Name <> Sheets(Sheets.Count).Name Then
        son = Sheets(i).Cells(Rows.Count, "C").End(3).Row
        yeni = WorksheetFunction.Max(12, Sheets(Sheets.Count).Cells(Rows.Count, "C").End(3).Row + 1)
        Sheets(i).Range("C12:AO" & son).Copy Sheets(Sheets.Count).Cells(yeni, "C")
    End If
    Next
    Cells.Select
    Selection.Copy
    Windows("Ana Uygunluk & Tarih Aralıkları Programı.xlsm").Activate
    Worksheets("Animals").Visible = xlSheetVisible
    Sheets("Animals").Select
    Cells.Select
    Range("a1").Activate
    ActiveSheet.Paste
    Sheets("Animals").Select
    Application.DisplayAlerts = False
    Workbooks(Dosyasonu).Close SaveChanges:=False
    Application.DisplayAlerts = True
    Worksheets("Animals").Visible = xlSheetVeryHidden
    Worksheets("Sayfa4").Visible = xlSheetVeryHidden
    Sheets("Ana Sayfa").Select
    Range("A1").Select
    MsgBox ("Hayvan Varlığı Listesi Başarıyla Yüklendi."), vbInformation
    End If
    Application.ScreenUpdating = True
End Sub

Korhan Ayhan · 23 Mayıs 2022

Deneyiniz.

Kendi sisteminize göre dosya yolunu değiştirmeyi unutmayınız.

C++:

Option Explicit

Sub Last_File_Open()
    Dim FSO As Object, Source_Folder As Object
    Dim My_Path As String, My_File As Object
    Dim My_File_Extension As String
    Dim Last_Date As Date, Last_File As String
    
    My_Path = "C:\Users\Admin\Downloads\"
    My_File_Extension = "xls"
    
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set Source_Folder = FSO.GetFolder(My_Path)

    For Each My_File In Source_Folder.Files
        If My_File.DateLastModified > Last_Date Then
            If InStr(1, FSO.GetExtensionName(My_File), My_File_Extension) > 0 Then
                Last_File = My_File
                Last_Date = My_File.DateLastModified
            End If
        End If
    Next
    
    Workbooks.Open Last_File, False, False
    
    MsgBox Last_File
End Sub

Salihd46 · 23 Mayıs 2022

hocam çok çok teşekkür ederim, ben kendi bilgisayarıma uygulayabilirim, çalıştı çok teşekkür ederim
fakat
My_Path = "C:\Users\Admin\Downloads\"

çalıştığım yerde diğer bilgisayarlarda ve aynı bilgisayarda kendi şifresi ile girince kullanıcı değişiyor.

aktif olan kullanıcı şeklinde bu kodu değiştirebilir miyiz acaba

admin = active_users gibi

Korhan Ayhan · 23 Mayıs 2022

Deneyiniz.

Active_User = Environ("UserProfile")

Salihd46 · 23 Mayıs 2022

hocam böyle uygulamaya çalıştım dediğinizi de, çalıştıramadım bu şekilde nerede yanlış yapıyorum acaba

Kod:

Sub Last_File_Open()
    Dim FSO As Object, Source_Folder As Object
    Dim My_Path As String, My_File As Object
    Dim My_File_Extension As String
    Dim Last_Date As Date, Last_File As String
    
    Dim Active_User As String
    
    Active_User = Environ("UserProfile")
    
    My_Path = "C:\\Users\Active_User\Downloads"
    
    My_File_Extension = "xls"
    
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set Source_Folder = FSO.GetFolder(My_Path)

    For Each My_File In Source_Folder.Files
        If My_File.DateLastModified > Last_Date Then
            If InStr(1, FSO.GetExtensionName(My_File), My_File_Extension) > 0 Then
                Last_File = My_File
                Last_Date = My_File.DateLastModified
            End If
        End If
    Next
    
    Workbooks.Open Last_File, False, False
    
    MsgBox Last_File
End Sub

Korhan Ayhan · 23 Mayıs 2022

Deneyiniz.

Tek satırda işi bitirebilirsiniz.

My_Path = Environ("UserProfile") & "\Downloads"

Salihd46 · 23 Mayıs 2022

hocam şu şekilde yaptım çalıştı, çok teşekkür ederim.

Kod:

My_Path = "" & Environ("UserProfile") & "\Downloads"

Korhan Ayhan · 23 Mayıs 2022

Pardon yanlış yönlendirdim. Paylaştığım kodu revize ettim. Deneyebilirsiniz.

Salihd46 · 23 Mayıs 2022

Korhan hocam,7 nolu mesajdaki kod da, düzelttiğiniz kod da çalışıyor. çok teşekkür ederim tekrar

Salihd46 · 24 Mayıs 2022

bi yardım daha alabilir miyim acaba,
şimdi en son indirilen exceli açıyorum tamam. içinden veriyi kopyalayıp esas programın sayfasına yapıştırıyorum. ardından en son indirilen exceli kapatmak için bir isim tarifi yazamadım da yardımcı olur musunuz, "dosyasonu" olarak tanımlamıştım. doğru tanım yapamadım. şimdiden teşekkür ederim

Dosyasonu = Worksheets(Environ("UserProfile") & "\Downloads").Name

Kod:

Sub Ekle()
    Application.ScreenUpdating = False
    Dim strDocument, Dosyasonu, Kitapadi As String
    Kitapadi = "Ana Uygunluk & Tarih Aralıkları Programı"

    Dosyasonu = Worksheets(Environ("UserProfile") & "\Downloads").Name

    Call Last_File_Open

    Range("a1").Select
    If Range("I6").Value <> "İŞLETMEDEKİ SIĞIR-MANDA TÜRÜ HAYVAN BİLGİ RAPORU" Then
        MsgBox ("Lütfen doğru liste seçiniz!"), vbCritical, "Hatalı Liste!"
    Else
    Cells.Select
    Selection.Copy
    Workbooks(Kitapadi).Activate
    Worksheets("Animals").Visible = xlSheetVisible
    Sheets("Animals").Selet
    Cells.Select
    Range("a1").Activate
    ActiveSheet.Paste
    Workbooks(Dosyasonu).Close SaveChanges:=False
    Worksheets("Animals").Visible = xlSheetVeryHidden
    Worksheets("Sayfa4").Visible = xlSheetVeryHidden
    Sheets("Ana Sayfa").Select
    Range("A1").Select
    MsgBox ("Hayvan Varlığı Listesi Başarıyla Yüklendi."), vbInformation
    End If
    Application.ScreenUpdating = True
End Sub

Salihd46 · 24 Mayıs 2022

arkadaşlar çalıştım ve buldum belki istifade edenler olur diye yazıyorum, kolay gelsin

açılan excel dosyasını kapatmak için ayrı bir makro oluşturup (öncekini düzenleyip) onu çalıştır diye yazdım ve çalıştı

iyi çalışmalar...

Kod:

Sub Last_File_Close()
    Dim FSO As Object, Source_Folder As Object
    Dim My_Path As String, My_File As Object
    Dim My_File_Extension As String
    Dim Last_Date As Date, Last_File As String
    My_Path = Environ("UserProfile") & "\Downloads"
    My_File_Extension = "xls"
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set Source_Folder = FSO.GetFolder(My_Path)

    For Each My_File In Source_Folder.Files
        If My_File.DateLastModified > Last_Date Then
            If InStr(1, FSO.GetExtensionName(My_File), My_File_Extension) > 0 Then
                Last_File = My_File
                Last_Date = My_File.DateLastModified
            End If
        End If
    Next
    Workbooks.Open Last_File
    ActiveWorkbook.Close Last_File
End Sub

Korhan Ayhan · 24 Mayıs 2022

Yazdığınız şekilde hatalı olur.

Aşağıdaki gibi deneyiniz.

ActiveWorkbook.Close False

Salihd46 · 25 Mayıs 2022

açtığım excelde değişiklik yapma kodu olmayınca olmuştu 11 nolu mesajdaki kod da, ben normalde biraz değişiklik yapıp ardından veri aldığım için,
excel zaten açık tekrar açılsın mı uyarısı veriyor, her defasında bu uyarıya evet desek çözülür de olmasa tabi daha kullanışlı olacak.

Workbooks.Open Last_File yazmadan,
ActiveWorkbook.Close False kodunu direk yazarsam mevcut ana exceli kapatıyor, sonradan açtığımı değil.

sadece
Workbook(Last_File).Close False şeklinde yapmayı denedim, bu da çalışmadı, hep hata veriyor bu satırda, anlamadım çalışması lazım aslında,

yani sonradan açtığım exceli tarif ile kapatamadım

Korhan Ayhan · 25 Mayıs 2022

Deneyiniz.

Workbooks(Last_File).Close False

Salihd46 · 26 Mayıs 2022

Korhan hocam sizi de yordum kusura bakmayın, başta yazdığınız kod için yeniden teşekkür ederim, ama 14 nolu mesajda yazdığınız kod da hata veriyor, benim dosya yükleme makrom aşağıda ve hata veren satır şu;

Workbooks(Last_File).Close False

dosya açılıyor, düzenleniyor, yükleniyor ardından kapanmıyor

Kod:

Sub Ekle()

    Application.ScreenUpdating = False
    Dim Kitapadi As String
    Dim FSO As Object, Source_Folder As Object
    Dim My_Path As String, My_File As Object
    Dim My_File_Extension As String
    Dim Last_Date As Date, Last_File As String
    Kitapadi = "Ana Uygunluk & Tarih Aralıkları Programı"
    
    My_Path = Environ("UserProfile") & "\Downloads"
    My_File_Extension = "xls"
    
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set Source_Folder = FSO.GetFolder(My_Path)
    For Each My_File In Source_Folder.Files
        If My_File.DateLastModified > Last_Date Then
            If InStr(1, FSO.GetExtensionName(My_File), My_File_Extension) > 0 Then
                Last_File = My_File
                Last_Date = My_File.DateLastModified
            End If
        End If
    Next
    
    Workbooks.Open Last_File, False, False
    
    Range("a1").Select
    If Range("I6").Value <> "İŞLETMEDEKİ SIĞIR-MANDA TÜRÜ HAYVAN BİLGİ RAPORU" Then
        MsgBox ("Lütfen doğru liste seçiniz!"), vbCritical, "Hatalı Liste!"
        
        
    Else
    
    Sheets(1).Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Range("A12:AR" & Rows.Count).ClearContents
    For i = 1 To Sheets.Count
    If Sheets(i).Name <> Sheets(Sheets.Count).Name Then
        son = Sheets(i).Cells(Rows.Count, "C").End(3).Row
        yeni = WorksheetFunction.Max(12, Sheets(Sheets.Count).Cells(Rows.Count, "C").End(3).Row + 1)
        Sheets(i).Range("C12:AO" & son).Copy Sheets(Sheets.Count).Cells(yeni, "C")
    End If
    Next
    Cells.Select
    Selection.Copy
    Workbooks(Kitapadi).Activate
    Worksheets("Animals").Visible = xlSheetVisible
    Sheets("Animals").Select
    Cells.Select
    Range("a1").Activate
    ActiveSheet.Paste
    Worksheets("Animals").Visible = xlSheetVeryHidden
    Worksheets("Sayfa4").Visible = xlSheetVeryHidden
    Sheets("Ana Sayfa").Select
    Range("A1").Select
    MsgBox ("Hayvan Varlığı Listesi Başarıyla Yüklendi."), vbInformation
    
    Workbooks(Last_File).Close False

    End If

End Sub

Korhan Ayhan · 26 Mayıs 2022

Önerdiğim satırı END SUB yazan yerin bir üstüne alarak deneyiniz.

Salihd46 · 26 Mayıs 2022

hocam tarif ettiğiniz şekilde denedim maalesef tekrar hata verdi

Korhan Ayhan · 26 Mayıs 2022

Aynı yere aşağıdaki satırı uygulayıp deneyiniz.

Workbooks(Replace(Last_File, My_Path, "")).Close False

Salihd46 · 26 Mayıs 2022

üzülerek yazıyorum, hocam o da hata verdi maalesef,
şu şekilde denedim ben de,

kapat = Workbooks(Last_File).Name

Workbooks(kapat).Close False

bu da hata verdi hocam, ayrıca;

mausu Last_File üzerine getirince doğru hedefi gösteriyor, fakat "kapat" üzerine getirince Empty yazıyor,

"kapat" hedefini tam tarif edemiyorum sanırım hocam, ben öyle anladım

Korhan Ayhan · 26 Mayıs 2022

En son önerdiğim kodu deneyerek paylaştım. Bende çalışıyor.

En son indirilen exceli makro ile açmak

Salihd46

Korhan Ayhan

Administrator

Salihd46

Korhan Ayhan

Administrator

Salihd46

Korhan Ayhan

Administrator

Salihd46

Korhan Ayhan

Administrator

Salihd46

Salihd46

Salihd46

Korhan Ayhan

Administrator

Salihd46

Korhan Ayhan

Administrator

Salihd46

Korhan Ayhan

Administrator

Salihd46

Korhan Ayhan

Administrator

Salihd46

Korhan Ayhan

Administrator