1 sayfadan 1. sayfa

Klasörde Bulunan Son Exceli Ana Dosyaya Aktarma

İletiTarih: 29 Tem 2022 15:57
thesecret
Herkese Merhaba.

Şirketimize ait bir yazılımdan günlük olarak bir veri tablosu oluşturuyoruz. Günlük olarak ismi değişen bu dosyayı ben makro ile kendi ana excel dosyama aktarmak istiyorum. Dosya aktarma işlemlerini
Kod: Tümünü seç
ChDir
ile konumunu göstererek ilgili dosyama çekiyorum onda problem yok ancak benim öğrenmek istediğim günlük değişen bu dosya ismini ben nasıl otomatik aktarabilirim?

Örnek olarak; günlük oluşan dosyamızın isimleri LISTE20220729,LISTE20220728,LISTE20220727.xls vb. Ana dosyamın ismi de Deneme.xlsm olsun. Deneme.xlsm dosyamın içerisinde koyduğum bir butonla LISTE20220729.xls dosyasını açsın ve içerisindeki tüm veriyi Deneme.xlsm dosyamın A1 hücresine kopyalasın istiyorum(Burada içeri aktarılacak dosya o konumda tarih ve zaman olarak oluşan son dosyadır). Veya Deneme.xlsm dosyamdaki butona tıkladığımda belirttiğim konum açılsın ben oradan dosyayı seçip açayım o dosyadaki verileri otomatik aktarsın gibi. Hangisi daha mantıklı bilemedim, bu artık takdirinize kalmış.

Zaman ayırdığınız için teşekkür ediyorum.

İyi çalışmalar.

Cevap: Klasörde Bulunan Son Exceli Ana Dosyaya Aktarma

İletiTarih: 02 Ağu 2022 14:15
Ali ÖZ
Deneyin.
İçinde bulunulan günün tarihine göre dosya isminden veri çeker.

Kod: Tümünü seç
Private Sub CommandButton1_Click()
Set baglan = CreateObject("AdoDb.connection")
Set rs = CreateObject("AdoDb.Recordset")
Dim dosya As String
dosya = "LISTE" & Format(Now, "yyyyddmm")
baglan.Open "Provider=microsoft.ACE.oledb.12.0;data source=" & ThisWorkbook.Path & _
"\" & dosya & ".xlsx;extended properties=""excel 12.0;hdr=yes"""
rs.Open "SELECT * FROM [Sayfa1$]", baglan, 1, 3
rs.movefirst
Range("a1").CopyFromRecordset rs
rs.movefirst
rs.Close
baglan.Close
Set rs = Nothing
Set baglan = Nothing
End Sub

Cevap: Cevap: Klasörde Bulunan Son Exceli Ana Dosyaya Aktarm

İletiTarih: 02 Ağu 2022 14:42
thesecret
Ali ÖZ yazdı:Deneyin.
İçinde bulunulan günün tarihine göre dosya isminden veri çeker.

Kod: Tümünü seç
Private Sub CommandButton1_Click()
Set baglan = CreateObject("AdoDb.connection")
Set rs = CreateObject("AdoDb.Recordset")
Dim dosya As String
dosya = "LISTE" & Format(Now, "yyyyddmm")
baglan.Open "Provider=microsoft.ACE.oledb.12.0;data source=" & ThisWorkbook.Path & _
"\" & dosya & ".xlsx;extended properties=""excel 12.0;hdr=yes"""
rs.Open "SELECT * FROM [Sayfa1$]", baglan, 1, 3
rs.movefirst
Range("a1").CopyFromRecordset rs
rs.movefirst
rs.Close
baglan.Close
Set rs = Nothing
Set baglan = Nothing
End Sub


Ali Bey,
Çok teşekkür ederim. Hemen deneyeceğim. Alternatif olarak
Kod: Tümünü seç
Dim dosya As String
Sub choosefile()
    dosya = Application.GetOpenFilename("Sadece Excel Dosyaları (*.xls),*.xls")
    If dosya <> "False" Then
        MsgBox "Dosya Seçimi Tamamlandı. Veriler Otomatik Aktarılacaktır."
    Call transferfile
    Else
        MsgBox "Herhangi Bir Dosya Seçmediniz. İşlem İptal Edildi !"
    End If
End Sub

Sub transferfile()

If dosya <> "" Then
        On Error GoTo hata
           Application.ScreenUpdating = False
               Set kaynak = Workbooks.Open(dosya, True, True)
    kaynak.Worksheets("Sheet1").Range("A5:J25000").Copy ThisWorkbook.Sheets("Sheet2").Range("B2")
           kaynak.Close False
           Set kaynak = Nothing
           
hata:
           
           Application.ScreenUpdating = True
Else
    MsgBox "Herhangi Bir Dosya Seçmediniz. İşlem İptal Edildi !"
End If
End Sub


araştırıp bulduğum yukarıdaki kodları kullanarak seçim yapıp aktarmak daha mantıklı geldi. İyi çalışmalar.