aynı dosyadaki kapalı excel kitaplarından veri almak

[suskun127]

örnek dosya ektedir. aynı klasörün içindeki listelerden veri tabanı kitabına verileri nasıl çekerim güncellle butonuna bastığım da liste en güncel halde veritabanı kitabındaki listelere veriyi nasıl atar mesela mesela veri aldığı kitaplardan herhangi bir veri silinmişse veritabanındanda silinecek(güncelle dediğimde) veri eklenmişse de eklenecek yani her güncelle dediğmde veri tabanı kitabı en güncel verilere sahip olmalı
yardımlarınız için şimdiden teşekkürler

 

[suskun127]

bu arada herkesin mübarek kurban bayramını kutlarım saygılar.

 

[ziya]

Merhaba,
Aşağıdaki linkte değişik çalışmalar var.
http://www.excel.web.tr/forumdisplay.php?f=117

 

[Orion1]

Dosyanız ektedir.

Sub kapali_aktar()
Dim fso As Object, f As Object, dosya As String, fs As Object, sayfa As String
Dim conn As ADODB.Connection, rs As ADODB.Recordset, uzanti As String, k As Range
Dim sat As Long
'Referanslardan microsoft activex object 2.8 library eklenmiştir.
Sheets("Sayfa1").Select
Set fso = CreateObject("Scripting.FileSystemObject")
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set f = fso.getfolder(ThisWorkbook.Path).Files
For Each fs In f
    dosya = fs.Name
    uzanti = fso.GetExtensionName(fs)
    sayfa = Left(dosya, Len(dosya) - Len(uzanti) - 1)
    If dosya <> ThisWorkbook.Name Then
        Set k = Range("B:B").Find(sayfa, , xlValues, xlWhole)
        If Not k Is Nothing Then
            sat = k.Row + 2
            Range("A" & sat & ":H" & sat + 10).ClearContents
            conn.Open ("Provider=microsoft.jet.oledb.4.0;data source=" & fs & ";extended properties=""excel 8.0;hdr=yes;""")
            rs.Open "Select * from [" & sayfa & "$];", conn, adOpenDynamic, adLockOptimistic
            Range("A" & sat).CopyFromRecordset rs
            rs.Close
            conn.Close
        End If
    End If
Next
Set rs = Nothing: Set conn = Nothing
MsgBox "Veriler Kapalı dosyalardan başarı ile alındı." & vbLf & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[suskun127]

sn Evren Gizlen
çok teşekkür ederim çok faydalı oldu sağolun varolun

 

[Orion1]

sn Evren Gizlen
çok teşekkür ederim çok faydalı oldu sağolun varolun

Rica ederim.
İyi çalışmalar.

 

[intermed]

T

Dosyanız ektedir.

Sub kapali_aktar()
Dim fso As Object, f As Object, dosya As String, fs As Object, sayfa As String
Dim conn As ADODB.Connection, rs As ADODB.Recordset, uzanti As String, k As Range
Dim sat As Long
'Referanslardan microsoft activex object 2.8 library eklenmiştir.
Sheets("Sayfa1").Select
Set fso = CreateObject("Scripting.FileSystemObject")
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set f = fso.getfolder(ThisWorkbook.Path).Files
For Each fs In f
    dosya = fs.Name
    uzanti = fso.GetExtensionName(fs)
    sayfa = Left(dosya, Len(dosya) - Len(uzanti) - 1)
    If dosya <> ThisWorkbook.Name Then
        Set k = Range("B:B").Find(sayfa, , xlValues, xlWhole)
        If Not k Is Nothing Then
            sat = k.Row + 2
            Range("A" & sat & ":H" & sat + 10).ClearContents
            conn.Open ("Provider=microsoft.jet.oledb.4.0;data source=" & fs & ";extended properties=""excel 8.0;hdr=yes;""")
            rs.Open "Select * from [" & sayfa & "$];", conn, adOpenDynamic, adLockOptimistic
            Range("A" & sat).CopyFromRecordset rs
            rs.Close
            conn.Close
        End If
    End If
Next
Set rs = Nothing: Set conn = Nothing
MsgBox "Veriler Kapalı dosyalardan başarı ile alındı." & vbLf & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

Sayın Evren Bu kodu Aynı klasör içindeki tüm dosyaların(dosya sayısı belli değil) sayfa1'lerindeki dolu satır sayıları(kaç satır olduğu her dosya da farklı) kadar alıp anasayfaya altalta listeleyecek şekilde yapabilir mısınız.

 

[Orion1]

Sayın Evren Bu kodu Aynı klasör içindeki tüm dosyaların(dosya sayısı belli değil) sayfa1'lerindeki dolu satır sayıları(kaç satır olduğu her dosya da farklı) kadar alıp anasayfaya altalta listeleyecek şekilde yapabilir mısınız.

Zaten öyle yapıyor.Denedinizmi?