Kapalı dosyadan verı alma

[mtbi00]

ıyı gunler

elımde aynı formattan 3 dosya var. Hepsınde de degısık bılgıler mevcut. Forumda aradım ama buldugum ornekler benım gıbı acemı bırı ıcın cok karısık, ıcınden cıkamadım. Sızden rıcam ekte ekledıgım dosyalarda anadosya ıcındekı bılgılerı getır butonuna bastıgımda dıger dosyalardan (a,b ve c) dosyalarındakı bılgılerı anadosya sayfa1 yuklemek ve ısıme gore sıralatmak ıcın nasıl bır makro yazabılırım. Anlayabılmek amacıyla basıt bır ornek olmasını ıstedım. Bırde bu arada kapalı dosyalar ıcın yol belırtebılırmıyız. Yardımlarınız ıcın sımdıden tesekkur ederım.

 

[Orion1]

Dosya ektedir.

Sub ado_ile_aktar()
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim sat As Long, fso As Object, f As Object, dosya
'Referanslardan microsoft activex dataobjext 2.8 libraray seçildi
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.getfolder(ThisWorkbook.Path).Files
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
For Each dosya In f
    If dosya.Name <> ThisWorkbook.Name Then
        Set conn = New ADODB.Connection
        conn.Open ("Provider=Microsoft.jet.oledb.4.0;Data source=" & ThisWorkbook.Path & "\" & dosya.Name & ";extended properties=""Excel 8.0;hdr=yes""")
        Set rs = New ADODB.Recordset
        rs.Open "Select * from [Sayfa1$] order by ADI,SOYADI;", conn, adOpenDynamic, adLockOptimistic
        sat = Cells(65536, "A").End(xlUp).Row + 1
        Range("A" & sat).CopyFromRecordset rs
        rs.Close: conn.Close
        Set rs = Nothing: Set conn = Nothing
    End If
Next
Application.ScreenUpdating = True
MsgBox "Klasöredki dosyalar aktarıldı." & vbLf & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[mtbi00]

hocam eline sağlık çok teşekkür ederim.

 

[Orion1]

hocam eline sağlık çok teşekkür ederim.

Rica ederim.
İyi çalışmalar.

 

[drejan62]

Evren hocam elinize sağlık,
imkanınz varsa bu kodları kısaca açıklamanız mümkünmüdür acaba?
Teşekkürler.

 

[Orion1]

Evren hocam elinize sağlık,
imkanınz varsa bu kodları kısaca açıklamanız mümkünmüdür acaba?
Teşekkürler.

Lütfen imzamı okuyunuz.

 

[drejan62]

Lütfen imzamı okuyunuz.

Anlamadım?

 

[mtbi00]

Bende merak ettım doğrusu? "lutfen ımzamı okyunuz" ????

 

[Orion1]

Bende merak ettım doğrusu? "lutfen ımzamı okyunuz" ????

Evet o yazının altında Kırmızı renkle yazılmış kalın puntolu yazı İmza bölümüdür.
Oraya imzanızı yazarsınız.Forumlarda bu böyle geçiyor.

 

[mtbi00]

Anladım hocam. Peki o zaman eğer müsaitseniz, vaktiniz var ve kızmazsanız kodlarının acıklamalarını yanına yazabılırmısınız. Hazırı alıp uygulamaktansa bılıp yazmak daha makbul gıbı gelıyor...

 

[Orion1]

Anladım hocam. Peki o zaman eğer müsaitseniz, vaktiniz var ve kızmazsanız kodlarının acıklamalarını yanına yazabılırmısınız. Hazırı alıp uygulamaktansa bılıp yazmak daha makbul gıbı gelıyor...

Hazırı alıp uygulamayın.Uygulayın ama kodlarıda inceleyin.Ben öyle yaparak öğrendim.Burada her kodu açıklamya kalksak kod yazamayız.Bu kodları yazmamız bile sizin için bulunmaz bir fırsattır.Bunu değerlindermeniz lazım.Gerekirse internetten araştırın.Makaleler bulun okuyun.

 

[mtbi00]

Sağol hocam ellerıne ağzına sağlık. Kodları yazmanız konusunda son derece haklısınız. Gostermıs oldugunuz ılgı ve alakadan dolayı cok tesekkur ederım.

 

[Orion1]

Sağol hocam ellerıne ağzına sağlık. Kodları yazmanız konusunda son derece haklısınız. Gostermıs oldugunuz ılgı ve alakadan dolayı cok tesekkur ederım.

Kodları inceleyip bol bol pratik yapın.Değiştirip değiştirip çalışın.İnanaın böyle öğrendikleriniz çok daha kalıcı olur anlatmaktan.Anlatılsada bir süre sonra unutulur.Siz kodların ne dediğini pratik yaparak anlamılısınız.Ben öyle öğrendim.Öyle yapmasaydım hiç bir şey öğrenemzdim.Halada öğreniyorum.Bir şey gördüğüm zaman hemen onu tecrübe ediyorum.Üzerinde bir süre çalışıyorum.Ve konuyu anlıyorum.Bir dahada unutmuyorum.Bu forumda bu konuda yani anlatın diye istekte bulunan çok üye var.Bu söylediklerimi iyicene okusunlar.