• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

xlsx dosyasını kolay şekilde mdb yapmak

I

incsoft

Katılım
18 Ağustos 2009
Mesajlar
752
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
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.
 
Örnek ufak bir dosya ekleyebilir misiniz.
 
Örnek;

ACCDB Dosyası Oluşturma veya Editleme

Merhaba, Bilgisayarımda access yüklü değil. xlsx uzantılı bir dosyayı accdb olarak nasıl kaydedebilirim? Fikriniz var mı? Veya başka bir çözümünüz var mı? Teşekkürler
www.excel.web.tr www.excel.web.tr

.
 
Haluk' Alıntı:
Örnek;

ACCDB Dosyası Oluşturma veya Editleme

Merhaba, Bilgisayarımda access yüklü değil. xlsx uzantılı bir dosyayı accdb olarak nasıl kaydedebilirim? Fikriniz var mı? Veya başka bir çözümünüz var mı? Teşekkürler
www.excel.web.tr www.excel.web.tr

.
Genişletmek için tıkla ...


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

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:
Erdem Akdemir' Alıntı:
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
Genişletmek için tıkla ...

Ö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
 
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.
 
Debug yaptığınızda hatayı hangi satırda gösteriyor.
Gerçek dosyanızın örneğini eklerseniz bakabilirim.
 
Eklediğiniz dosya boş ve sayfa ismi Sayfa1 olarak görünüyor.
Debug yaptığınızda nerede hata alıyorsunuz onuda eklermisiniz.
 
Sayfa isminden dolayı hata almıyor. Nesne oluşturulamadı hatası vermiş sizde.
 
Kullanıcı bilgilerinizde ofis 2016 kullanıyor görünüyor. Hangi ofis versiyonu kullanıyorsunuz.
 
Hata veren satırı aşağıdaki gibi değiştirin.

Kod: 
    Set appAccess = CreateObject("Access.Application")
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst