A.S.C Filtre, Grafik ve Raporlama Eklentisi

Accesste Excel Birleştir
#1
Arkadaşlar Kolay Gelsin

Access veritabanında Hazırlamış Olduğum Öğrenci_Takip Programında Biryerde Takıldım
Accesste Excel Dosyalarını Birleştirmek İstiyorum
Access veritabanını açtığımda Excellden Veri Alma Formu Karşımıza Geliyor
Exceldeki Verileri Almak İçin Tıklayın Butonuna Tıklayınca ( Sınıf1 ) excel dosyasındaki verileri Accesse Tablo ( Ogreci_Takip ) Dosyasına Aktara Biliyorum

Benim Sizlerden İstediğim 
Exceldeki Verileri Almak İçin Tıklayın Butonuna Tıklayınca Kaçtane Excel Sınıf Dosyası varsa ( Sınıf1 - Sınıf2 - Sınıf3 - Sınıf4 - Sınıf5 - Sınıf6 - Sınıf7 - Sınıf8 - Sınıf9 - Sınıf10 ) Dosyalarını Access Veri Tabanında Ogrenci_Takip Tablosunda Alt Alta Birleştirmek İstiyorum. 

Yardımlarınız İçin Çok Teşekkür Ederim Sağolun


Eklenti Dosyaları
.rar   Accesste Excel Birleştir.rar (Boyut: 359,23 KB / İndirilme: 12)



  Alıntı
Bu mesajı beğenenler:
#2
Sayın Bora34
Ekteki dosyayı inceler misiniz ?


Eklenti Dosyaları
.rar   Accesste_Excel_Birlestir_userx53.rar (Boyut: 365,01 KB / İndirilme: 23)



  Alıntı
Bu mesajı beğenenler:
#3
Sayın. Userx53 Elinize Emeğinize Sağlık Çok Teşekkür Ederim
Konumla İlgilenen İlgilenemeyen Tüm Arkadaşlara Çok Teşekkür Ederim

Sayın. Userx53 Evet Tam İstediğim Gibi Olmuş. Tek Sıkıntı 1 ve 10 Adet Excel Sınıf Dosyaları var 10 Dosyayı Birleştirmede Sorun Yok
Burada 1 den 10 kadar değil de 1 den 6 ya kadar excel sınıf dosyası da olabiliyor. Bu nedenle Sınıf1 - Sınıf2 - Sınıf3 - Sınıf4 - Sınıf5 - Sınıf6 Dosyası Birleştirmek İstediğimde Hata Veriyor.
En az 1 Excel Sınıf Dosyası Varsa Klasörde Sadece 1 Dosyayı Birleştirecek. Birden Fazla Excel Sınıf Dosyası varsa 15 veya 20 sınıf excel dosyası varsa hepsini birleştirmesini istiyorum. Kaç adet Excel Sınıf Dosyası varsa Klasör İçerisinde onları Birleştirmek İstiyorum. 
1 adet sınıf dosyası varsa sadece o dosyayı

5 adet sınıf dosyası varsa 5 adet dosyayı birleştirecek
10 adet sınıf dosyası varsa 10 adet dosyayı birleştirecek
18 adet sınıf dosyası varsa 18 adet dosyayı birleştirecek
25 adet sınıf dosyası varsa 25 adet dosyayı birleştirecek

Teşekkür Ederim



  Alıntı
Bu mesajı beğenenler:
#4
aşağıdaki kodu dener misiniz?
Visual Basic
  1. Function ExcelEkle()
  2. CurrentDb.Execute "DELETE * FROM [Ogrenci_Takip]"
  3.  
  4.  
  5. sPath = CurrentProject.Path & "\"
  6. sFile = Dir(sPath & "Sınıf*.xlsx")
  7. Do While sFile <> vbNullString
  8. yol = sPath & sFile
  9. Set conn = CurrentProject.Connection
  10. Set rs1 = New ADODB.Recordset
  11.  
  12. Set rs = New ADODB.Recordset
  13. Set con = New ADODB.Connection
  14. Debug.Print sPath & sFile
  15. sSql = "select * from [2019-2020$A2:O] where not isnull(f1)"
  16.  
  17.  
  18. con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & yol & ";extended properties=""excel 12.0;hdr=no;imex=1"""
  19. CurrentDb.TableDefs.Refresh
  20.  
  21. rs.CursorLocation = adUseClient
  22. rs.CursorType = adOpenKeyset
  23. rs.LockType = adLockOptimistic
  24.  
  25. rs1.Open "[Ogrenci_Takip]", conn, adOpenDynamic, adLockOptimistic, adCmdTable
  26.  
  27. rs.Open sSql, con
  28.  
  29. Do Until rs.EOF
  30. rs1.AddNew
  31. ' rs1.Fields("SNO").Value = rs(0).Value
  32. rs1.Fields("Adi_Soyadi").Value = rs(1).Value
  33. rs1.Fields("TCKimlikNo").Value = rs(3).Value
  34. rs1.Fields("Telefon").Value = rs(4).Value
  35. rs1.Fields("Adresi").Value = rs(3).Value
  36. 'rs1.Fields("Burs").Value = rs(6).Value
  37. rs1.Fields("Burs").Value = "Alanlar"
  38. rs1.Fields("Başvuru_Tarihi").Value = rs(7).Value
  39. rs1.Fields("tbl_iller").Value = rs(8).Value
  40. rs1.Fields("tbl_universiteler").Value = rs(9)
  41. rs1.Fields("tbl_fakulteler").Value = rs(10).Value
  42. rs1.Fields("tbl_bolumler").Value = rs(11).Value
  43. rs1.Fields("Durumu").Value = rs(12).Value
  44. rs1.Fields("Simdiki_Sinifi").Value = rs(13).Value
  45. rs1.Fields("Gectigi_Sinifi").Value = rs(14).Value
  46.  
  47. rs1.Update
  48. rs1.MoveNext
  49. rs.MoveNext
  50. DoEvents
  51. Loop
  52.  
  53. CurrentDb.TableDefs.Refresh
  54. rs.Close
  55. con.Close
  56. Set rs = Nothing
  57. Set con = Nothing
  58.  
  59. rs1.Close
  60. conn.Close
  61.  
  62. Set rs1 = Nothing
  63. Set conn = Nothing
  64.  
  65. sFile = Dir 'Loop through the next file that was found
  66. Loop
  67. End Function





  Alıntı
Bu mesajı beğenenler:
#5
yada daha kısa olan aşağıdaki fonksiyonu
Not: bu yöntem bir öncekinin 1/5   kadar kısa sürede bitiyor
100 lük bir döngüde 4. mesajdaki 45 sn kadar sürerken bu sadece 8-9 saniye sürüyor
Visual Basic
  1. Function ExcelEkleT()
  2.   CurrentDb.Execute "DELETE * FROM [Ogrenci_Takip]"
  3.  
  4.    sPath = CurrentProject.Path & "\"
  5.    sFile = Dir(sPath & "Sınıf*.xlsx")
  6.    Do While sFile <> vbNullString
  7.        yol = sPath & sFile
  8.        SQL = "insert into [Ogrenci_Takip] ([Adi_Soyadi], [Telefon], [tbl_universiteler], [tbl_fakulteler], [Simdiki_Sinifi], [Gectigi_Sinifi], [Durumu], [tbl_bolumler], [Başvuru_Tarihi], [tbl_iller], [Burs], [Adresi], [TCKimlikNo]) " & _
  9.              "SELECT [ADI SOYADI], [Telefon], [tbl_universiteler], [tbl_fakulteler],  [Önceki Sınıfı],[Simdiki Sınıfı],  [Durumu], [tbl_bolumler], [Başvuru_Tarihi], [tbl_iller], 'Alanlar', [Adresi], [TCKimlikNo] " & _
  10.               "FROM [2019-2020$] IN '" & yol & "' 'EXCEL 8.0;' where not isnull([ADI SOYADI])"
  11.        CurrentDb.Execute SQL
  12.  
  13.        sFile = Dir     'Loop through the next file that was found
  14.    Loop
  15. End Function





  Alıntı
Bu mesajı beğenenler:
#6
Mesaj #2 deki dosya güncellendi



  Alıntı
Bu mesajı beğenenler:


Benzer Konular...
Konu: Yazar Cevaplar: Gösterim: Son Mesaj
  Excel Birleştir Ve Süz Bora34 2 92 16-06-2021, 23:22
Son Mesaj: Bora34
  Excel - Access Bağlantısı gokhan003 3 245 09-04-2021, 08:11
Son Mesaj: dsezgin
  Excel Export gunalp26 4 406 03-09-2020, 19:26
Son Mesaj: halily
  [MAKRO] Accesste Kurala Göre Sıralama selimglr 9 680 21-05-2020, 20:11
Son Mesaj: selimglr
  Excel & Acces siberdcit 1 472 27-11-2019, 02:37
Son Mesaj: dsezgin
  Accesste Pasta Grafik Oluşturma HilalAccess 7 834 21-10-2019, 17:39
Son Mesaj: dsezgin
  Excel'e Gönderirken Excel Sayfa Yapısı Ayarı husem 6 664 22-09-2019, 14:41
Son Mesaj: husem
  [SORGU] Excel Aktar Butonu ramazanke 5 860 30-01-2019, 10:46
Son Mesaj: ramazanke

Foruma Git:


Bu konuyu görüntüleyen kullanıcı(lar): 1 Ziyaretçi