ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[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.

[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

[thesecret]

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.