xlsx dosyasını kolay şekilde mdb yapmak

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
xlsx dosyaları hızlı bir şekilde paradox ya da mdb dosyasına dönüşebilirmi arkadaşlar? Elimde sürekli değişen 1.500.000 satır ve değişen veritabanı vardır ve bu verileri belli zamanlarda mdb formatında dönüştürülüyor ancak access ile her seferinde çok zor oluyor. Mesela bir macro ile mdb dosyası yapma imkanımız varmıdır?

Teşekkürler.
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Örnek ufak bir dosya ekleyebilir misiniz.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,298
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Örnek;


.
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Örnek;


.

Haluk bey buradaki bir örnekle çözdüm ancak benim dosyamda 34 farklı alan var bunları tek tek tanımlamamı yapmam gerekiyor. Dosyam ekte örneğin.
 

Ekli dosyalar

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Aşağıdaki kodu kullanabilirsiniz.
Excel dosyasının yeri masaüstü olarak konumlandırılmıştır. Yol değişkeninden kendiniz ayarlayabilirsiniz.
Access dosyası da masaüstünde oluşacaktır. Onun yerini de strDB değişkeninden ayarlayabilirsiniz.
Örnek dosyanızı 1.000.000 satıra çoğalttım , mdb dosyası 160 saniyede oluştu.

Kod:
Public strDB As String
Sub deneme_access2() 'access ile oluşturmak

Zaman = Timer
Set con = VBA.CreateObject("adodb.Connection")
Set rs = VBA.CreateObject("adodb.Recordset")

yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DATA.xlsx"

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from[sayfa1$] "
rs.Open sorgu, con, 1, 3

deg = rs.getrows
syc = rs.RecordCount - 1

rs.Close
con.Close
'-----------------------------------------------------------------------------

Call NewAccessDatabase2

con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & ";Persist Security Info=False;"

sorgu = "select * from[deneme]"

rs.Open sorgu, con, 1, 3

For i = 0 To syc
    rs.addnew
    For s = 0 To rs.Fields.Count - 1
     If deg(s, i) = "" Then deg(s, i) = Null
        rs.Fields(s) = deg(s, i)
    Next s
    rs.Update
Next i
'-----------------------------------------------------------------------------

Set rs = Nothing
Set con = Nothing

MsgBox "İşlem tamamlandı." & Chr(10) _
        & Format(Timer - Zaman, "0.00")

'MsgBox "İşlem tamamlandı."

End Sub

Sub NewAccessDatabase2()
    Dim appAccess As Object
    Dim dbs As Object, tdf As Object, fld As Variant
    Const DB_Text As Long = 10
    Const FldLen As Integer = 40

    Set con = VBA.CreateObject("adodb.Connection")

    yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DATA.xlsx"

    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    yol & ";extended properties=""Excel 12.0;hdr=yes"""

    Set rs = con.Execute("select * from[sayfa1$]")

    strDB = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Newdb.mdb"

    Set appAccess = CreateObject("Access.Application")
    appAccess.NewCurrentDatabase strDB

    Set dbs = appAccess.CurrentDb
    Set tdf = dbs.CreateTableDef("Deneme")

    For Each baslik In rs.Fields

    Set fld = tdf.CreateField(baslik.Name, DB_Text, FldLen)
        tdf.Fields.Append fld
    Next baslik

    dbs.TableDefs.Append tdf
    Set appAccess = Nothing
    rs.Close
    con.Close

End Sub
 
Son düzenleme:

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Aşağıdaki kodu kullanabilirsiniz.
Excel dosyasının yeri masaüstü olarak konumlandırılmıştır. Yol değişkeninden kendiniz ayarlayabilirsiniz.
Access dosyası da masaüstünde oluşacaktır. Onun yerini de strDB değişkeninden ayarlayabilirsiniz.
Örnek dosyanızı 1.000.000 satıra çoğalttım , mdb dosyası 160 saniyede oluştu.

Kod:
Public strDB As String
Sub deneme_access2() 'access ile oluşturmak

Zaman = Timer
Set con = VBA.CreateObject("adodb.Connection")
Set rs = VBA.CreateObject("adodb.Recordset")

yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DATA.xlsx"

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from[sayfa1$] "
rs.Open sorgu, con, 1, 3

deg = rs.getrows
syc = rs.RecordCount - 1

rs.Close
con.Close
'-----------------------------------------------------------------------------

Call NewAccessDatabase2

con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & ";Persist Security Info=False;"

sorgu = "select * from[deneme]"

rs.Open sorgu, con, 1, 3

For i = 0 To syc
    rs.addnew
    For s = 0 To rs.Fields.Count - 1
     If deg(s, i) = "" Then deg(s, i) = Null
        rs.Fields(s) = deg(s, i)
    Next s
    rs.Update
Next i
'-----------------------------------------------------------------------------

Set rs = Nothing
Set con = Nothing

MsgBox "İşlem tamamlandı." & Chr(10) _
        & Format(Timer - Zaman, "0.00")

'MsgBox "İşlem tamamlandı."

End Sub

Sub NewAccessDatabase2()
    Dim appAccess As Object
    Dim dbs As Object, tdf As Object, fld As Variant
    Const DB_Text As Long = 10
    Const FldLen As Integer = 40

    Set con = VBA.CreateObject("adodb.Connection")

    yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DATA.xlsx"

    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    yol & ";extended properties=""Excel 12.0;hdr=yes"""

    Set rs = con.Execute("select * from[sayfa1$]")

    strDB = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Newdb.mdb"

    Set appAccess = CreateObject("Access.Application.16")
    appAccess.NewCurrentDatabase strDB

    Set dbs = appAccess.CurrentDb
    Set tdf = dbs.CreateTableDef("Deneme")

    For Each baslik In rs.Fields

    Set fld = tdf.CreateField(baslik.Name, DB_Text, FldLen)
        tdf.Fields.Append fld
    Next baslik

    dbs.TableDefs.Append tdf
    Set appAccess = Nothing
    rs.Close
    con.Close

End Sub
Öncelikle teşekkürler Erdem bey. Bu kodu bir butona koydum olmadı. Mümkünse 1 örnek dosyaya adapte edip ekleme şansımız varmıdır?

Teşekkürler.


241154
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Kodu kayıt edilmiş bir excel dosyasında modüle ekleyin ve çalıştırın.
Debug yaptığınızda hatayı hangi satırda alıyorsunuz.
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Debug yaptığınızda hatayı hangi satırda gösteriyor.
Gerçek dosyanızın örneğini eklerseniz bakabilirim.
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Eklediğiniz dosya boş ve sayfa ismi Sayfa1 olarak görünüyor.
Debug yaptığınızda nerede hata alıyorsunuz onuda eklermisiniz.
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Sayfa isminden dolayı hata almıyor. Nesne oluşturulamadı hatası vermiş sizde.
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Kullanıcı bilgilerinizde ofis 2016 kullanıyor görünüyor. Hangi ofis versiyonu kullanıyorsunuz.
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Hata veren satırı aşağıdaki gibi değiştirin.

Kod:
    Set appAccess = CreateObject("Access.Application")
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Hata veren satırı aşağıdaki gibi değiştirin.

Kod:
    Set appAccess = CreateObject("Access.Application")
office 2021 ancak access sürümüm işyerimde lisanslı olmadığından dolayı access 2010 kullanıyorum
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Düzelmiş olması lazım.
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
office 2021 ancak access sürümüm işyerimde lisanslı olmadığından dolayı access 2010 kullanıyorum

Gayet güzel muhteşem elinize sağlık. Birde aynı dosya varsa sormadan üzerine yazarsa benim için tamamdır.

241236
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Sanırım birde şöyle sorun var sayısal alanları metin olarak atıyor kullandığım programda deneme yaptım toplama yapılacak alanlarda toplama yapamıyor. Matematiksel işlem yapacak şekilde değer olarak database'e atması mümkünmüdür? Sizide yordum kusura bakmayın hakkınızı helal edin hocam
 
Üst