• DİKKAT

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

Bilgilerim için veritabanı nasıl oluşturabilirim ?

Y

Yesilyurtlu

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Değerli Uzmanlarım

Exceldeki verilerime has " d:\ bordro\ yıllık " adı altında veritabanı nasıl oluşturabilirim
 

Ekli dosyalar

Merhaba,

Ne tip veritabanı istiyorsunuz? xls?, mdb?, txt?
 
Zeki GÜRSOY Uzmanım

Girdiğim verilere geri dönüşüm yapacağım için sizce uygun olan ne ise o olsun
Yani kişiye OCAK bordrosunu düzenledik VERİTABANINDA saklamaya saldık 5 ay sonra HAziran ayında geldi OCAK ayı bordrosunu istediği zaman VERİTABANINA gidip ocak bordro getir diyeceği veritabanı sizce hangisi ise o olsun


Ama Zeki Abi mantığınıda öğretmeniz mümkün mü?
 
Veritabanını xls olarak ve gerektiğinde üzerinde çalışabilmeniz için ekteki örnek gibi tasarladım. Umarım işinizi görür..

Modul:
Kod: 
Option Explicit
Public Const DB_PATH As String = "d:\bordro\yıllık\"

Sub yeni_DB()
Dim cvp As String

    cvp = InputBox("Yıl adı yazın:", , 2009)
    If cvp = "" Then Exit Sub
    
    If Dir(DB_PATH & cvp & ".xls") <> "" Then _
    MsgBox "Veritabanı zaten mevcut!", vbExclamation: Exit Sub

    Call yeni_yil(CInt(cvp))
    MsgBox "Veritabanı, '" & DB_PATH & cvp & ".xls'  " & Chr(13) & _
    "olarak oluşturuldu.", vbInformation
    
End Sub

Sub yeni_TABLO()
Dim cvp As String

    cvp = InputBox("Ay adını, Veritabanı adıyla (yılıyla)  " & Chr(13) & _
    "birlite ve ';' ayracı ile yazın.", , "OCAK;2009")
    If cvp = "" Then Exit Sub
    Call yeni_ay(cvp)
    
End Sub

Sub listeyi_KAYDET()
    Call kaydet([I1], [H1])
End Sub

Sub ekrana_LISTELE()
    Call listele([I1], [H1])
End Sub

Private Sub listele(yil As Integer, ay As String)
Dim cn As Object, rs As Object

Set cn = CreateObject("ADODB.Connection")

cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};ReadOnly=True;dbq=" & _
DB_PATH & yil & ".xls"

Set rs = cn.Execute("select * from [" & TR_Duzelt(ay) & "$]")

[a3:w1000].ClearContents
[a3].CopyFromRecordset rs

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

Private Sub yeni_yil(yil As Integer)
Dim app As Application
Dim wb As Workbook, z%
   
Set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Add

wb.Sheets(1).Name = yil

app.DisplayAlerts = False

For z = wb.Sheets.Count To 2 Step -1
    wb.Sheets(z).Delete
Next

wb.SaveAs DB_PATH & yil & ".xls"
app.Quit

Set wb = Nothing
Set app = Nothing
End Sub


Private Sub kaydet(yil As Integer, ay As String)
Dim cn As Object, rs As Object
Dim say&, y&, z%

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};ReadOnly=True;dbq=" & _
DB_PATH & yil & ".xls"

rs.Open "[" & ay & "$]", cn, 1, 3

say = [a1].Value + 2

For y = 3 To say
    rs.addnew
    For z = 1 To 23
        rs(z - 1) = Cells(y, z)
    Next
    rs.Update
Next

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

Private Sub yeni_ay(arg As String)
Dim cn As Object, arr1, arr2$, arr3$(), x$

arr1 = Array("SIRA", "GOREV_YERI", "ADI_SOYADI", "MED_DUR", "SIG_GUN_SAY", "MAAS_AY_GUN_SAY", _
             "SSK_MATRAH", "MAAS_TUT", "SSK_19_5", "DENGE_TAZ", "SEND_OD", "TAH_TOP", _
             "TOP_VER_MATR", "GEL_VER", "DAM_VER", "SSK_19__5", "SSK_14", "SEND_KES", _
             "ICRA", "KES_TOP", "AGI", "NET_OD", "BANKA_NO")

arr2 = Join(arr1, " VARCHAR(25), ") & " VARCHAR(25)"
arr3 = Split(arg, ";")

Set cn = CreateObject("ADODB.Connection")

cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};ReadOnly=True;dbq=" & _
DB_PATH & arr3(1) & ".xls"

On Error Resume Next
cn.Execute _
"CREATE TABLE " & TR_Duzelt(arr3(0)) & "(" & arr2 & ");"

cn.Close
Set cn = Nothing

x = TR_Duzelt(Left$(arg, InStr(1, arg, ";") - 1))
If Err Then
    MsgBox "'" & x & "' tablosu mevcuttur.", vbExclamation
Else
    MsgBox "Veritabanına '" & x & "' tablosu oluşturuldu.", vbInformation
End If
End Sub

Private Function TR_Duzelt(arg As String)
Dim tmp As String

tmp = BuyukHarf(arg)
tmp = Replace(tmp, "Ç", "C")
tmp = Replace(tmp, "Ğ", "G")
tmp = Replace(tmp, "İ", "I")
tmp = Replace(tmp, "Ö", "O")
tmp = Replace(tmp, "Ş", "S")
tmp = Replace(tmp, "Ü", "U")
TR_Duzelt = tmp
End Function

Private Function BuyukHarf(arg As String) As String
    BuyukHarf = UCase$(Replace(arg, "i", "İ"))
End Function

Private Function KucukHarf(arg As String) As String
    KucukHarf = LCase$(Replace(arg, "İ", "i"))
End Function
.
 

Ekli dosyalar

Zeki Gürsoy' Alıntı:
Veritabanını xls olarak ve gerektiğinde üzerinde çalışabilmeniz için ekteki örnek gibi tasarladım. Umarım işinizi görür..

Modul:
Kod: 
Option Explicit
Public Const DB_PATH As String = "d:\bordro\yıllık\"

Sub yeni_DB()
Dim cvp As String

    cvp = InputBox("Yıl adı yazın:", , 2009)
    If cvp = "" Then Exit Sub
    
    If Dir(DB_PATH & cvp & ".xls") <> "" Then _
    MsgBox "Veritabanı zaten mevcut!", vbExclamation: Exit Sub

    Call yeni_yil(CInt(cvp))
    MsgBox "Veritabanı, '" & DB_PATH & cvp & ".xls'  " & Chr(13) & _
    "olarak oluşturuldu.", vbInformation
    
End Sub

Sub yeni_TABLO()
Dim cvp As String

    cvp = InputBox("Ay adını, Veritabanı adıyla (yılıyla)  " & Chr(13) & _
    "birlite ve ';' ayracı ile yazın.", , "OCAK;2009")
    If cvp = "" Then Exit Sub
    Call yeni_ay(cvp)
    
End Sub

Sub listeyi_KAYDET()
    Call kaydet([I1], [H1])
End Sub

Sub ekrana_LISTELE()
    Call listele([I1], [H1])
End Sub

Private Sub listele(yil As Integer, ay As String)
Dim cn As Object, rs As Object

Set cn = CreateObject("ADODB.Connection")

cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};ReadOnly=True;dbq=" & _
DB_PATH & yil & ".xls"

Set rs = cn.Execute("select * from [" & TR_Duzelt(ay) & "$]")

[a3:w1000].ClearContents
[a3].CopyFromRecordset rs

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

Private Sub yeni_yil(yil As Integer)
Dim app As Application
Dim wb As Workbook, z%
   
Set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Add

wb.Sheets(1).Name = yil

app.DisplayAlerts = False

For z = wb.Sheets.Count To 2 Step -1
    wb.Sheets(z).Delete
Next

wb.SaveAs DB_PATH & yil & ".xls"
app.Quit

Set wb = Nothing
Set app = Nothing
End Sub


Private Sub kaydet(yil As Integer, ay As String)
Dim cn As Object, rs As Object
Dim say&, y&, z%

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};ReadOnly=True;dbq=" & _
DB_PATH & yil & ".xls"

rs.Open "[" & ay & "$]", cn, 1, 3

say = [a1].Value + 2

For y = 3 To say
    rs.addnew
    For z = 1 To 23
        rs(z - 1) = Cells(y, z)
    Next
    rs.Update
Next

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

Private Sub yeni_ay(arg As String)
Dim cn As Object, arr1, arr2$, arr3$(), x$

arr1 = Array("SIRA", "GOREV_YERI", "ADI_SOYADI", "MED_DUR", "SIG_GUN_SAY", "MAAS_AY_GUN_SAY", _
             "SSK_MATRAH", "MAAS_TUT", "SSK_19_5", "DENGE_TAZ", "SEND_OD", "TAH_TOP", _
             "TOP_VER_MATR", "GEL_VER", "DAM_VER", "SSK_19__5", "SSK_14", "SEND_KES", _
             "ICRA", "KES_TOP", "AGI", "NET_OD", "BANKA_NO")

arr2 = Join(arr1, " VARCHAR(25), ") & " VARCHAR(25)"
arr3 = Split(arg, ";")

Set cn = CreateObject("ADODB.Connection")

cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};ReadOnly=True;dbq=" & _
DB_PATH & arr3(1) & ".xls"

On Error Resume Next
cn.Execute _
"CREATE TABLE " & TR_Duzelt(arr3(0)) & "(" & arr2 & ");"

cn.Close
Set cn = Nothing

x = TR_Duzelt(Left$(arg, InStr(1, arg, ";") - 1))
If Err Then
    MsgBox "'" & x & "' tablosu mevcuttur.", vbExclamation
Else
    MsgBox "Veritabanına '" & x & "' tablosu oluşturuldu.", vbInformation
End If
End Sub

Private Function TR_Duzelt(arg As String)
Dim tmp As String

tmp = BuyukHarf(arg)
tmp = Replace(tmp, "Ç", "C")
tmp = Replace(tmp, "Ğ", "G")
tmp = Replace(tmp, "İ", "I")
tmp = Replace(tmp, "Ö", "O")
tmp = Replace(tmp, "Ş", "S")
tmp = Replace(tmp, "Ü", "U")
TR_Duzelt = tmp
End Function

Private Function BuyukHarf(arg As String) As String
    BuyukHarf = UCase$(Replace(arg, "i", "İ"))
End Function

Private Function KucukHarf(arg As String) As String
    KucukHarf = LCase$(Replace(arg, "İ", "i"))
End Function
.
Genişletmek için tıkla ...
Üstadım ben dosyayı açmaya çalıştım run time error 52 hatası verdi.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst