D:\ sürücüsündeki dosyadan veri alma

[Excelexcellent]

Merhaba

Worksheets("ARŞİVEKRAN").Range("A2:U65536").ClearContents
If ComboBox1.Value = "" Then Exit Sub
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & _
ThisWorkbook.Path & "\ARŞİV\" & ComboBox1.Value & ".xls;extended properties=""excel 8.0;hdr=yes"""

rs.Open "Select * from [VERİ$];", conn, 1, 1
Worksheets("ARŞİVEKRAN").Range("A2").CopyFromRecordset rs
rs.Close
conn.Close

Yukarıda görülen kod ile , ARŞİV isimli klasörde bulunan dosyalardan veri alıyorum.
ARŞİV isimli klasörü D:\ sürücüsünde muhafaza etmek istiyorum. Bu durumda verileri aynı şekilde alabilmek için,
yukarıdaki kodlarda ne gibi değişiklik yapmalıyım.
Teşekkürler

 

[Levent Menteşoğlu]

Aşağıdaki gibi düzenleyin.

If ComboBox1.Value = "" Then Exit Sub
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=[B][COLOR=#ff0000]D:\ARŞİV\[/COLOR][/B]" & _
ComboBox1.Value & ".xls;extended properties=""excel 8.0;hdr=yes"""
 
rs.Open "Select * from [VERİ$];", conn, 1, 1
Worksheets("ARŞİVEKRAN").Range("A2").CopyFromRecordset rs
rs.Close
conn.Close

 

[Excelexcellent]

Levent bey
Konu ile ilgilendiğiniz için teşekkür ederim.
Sizin verdiğiniz kodları uyguladım ancak aşağıdaki hatayı verdi ;

Run-time error 91
Object variableOr With Block variable not set

Kullandığım kodları ekliyorum.
D:\ARŞİV klasöründeki dosya isimleri combobox a alıyorum dosya adını seçtiğim zaman hata verdi

Dim conn As Object, rs As Object
Private Sub ComboBox8_Change()
Worksheets("ARŞİVEKRAN").Range("A2:I65536").ClearContents
If ComboBox8.Value = "" Then Exit Sub
[COLOR="Red"]conn.Open "Provider=microsoft.jet.oledb.4.0;data source=D:\ARŞİV\" & _
ComboBox8.Value & ".xls;extended properties=""excel 8.0;hdr=yes"""
[/COLOR]
rs.Open "Select * from [VERİ$];", conn, 1, 1
Worksheets("ARŞİVEKRAN").Range("A2").CopyFromRecordset rs
rs.Close
conn.Close
End Sub


Private Sub UserForm_Initialize()
Dim arsv As Object
Set arsv = CreateObject("scripting.filesystemobject")
Set klasor = arsv.getfolder("D:\ARŞİV")
For Each dosyalar In klasor.Files
If VBA.Right(dosyalar.Name, 3) = "xls" Then
ComboBox8.AddItem Replace(dosyalar.Name, ".xls", "")
End If
Next
End Sub

Sebebini anlayamadım ..?

 

[Mehmet Şahin]

Merhabalar,
kırmızı ile işaretledğiniz kodlardan önce aşağıdaki kodları ekleyerek denermisiniz. İyi çalışmalar.

Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset