umit1907
Altın Üye
- Katılım
- 9 Mayıs 2007
- Mesajlar
- 221
- Excel Vers. ve Dili
- 365 TR
- Altın Üyelik Bitiş Tarihi
- 18-04-2029
Merhabalar,
Ekteki gibi bir kod satırıyla kapalı dosyalardaki verileri çekebiliyorum yalnız çekilen verilerin karşısına örneğin "M" sutununada çcekilen dosya ismini yazdırmak istiyorum. Yardımcı olabilirmisiniz. Tüm verilerin karşısına yazılacaktır.
Private Sub CommandButton2_Click()
On Error Resume Next
Dim con As Object, evn As Object, yol As String
Sayfa2.Range("a2:z65536").ClearContents
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.getfolder(ThisWorkbook.Path & "\Siparişler")
For Each D In klasor.Files
If D.Name <> ThisWorkbook.Name Then
If VBA.Right(D.Name, 4) = "xlsx" Or VBA.Right(D.Name, 3) = "xls" Then
con.Open " provider=microsoft.ace.oledb.12.0;data source=" & _
D.Path & ";extended properties=""excel 12.0;hdr=no"""
sorgu = "select f2,f3,f14,f15,f16,f17,f18 from [Birleştirilmiş$a6:r300]"
rs.Open sorgu, con, 1, 1
Sayfa2.Range("b65536").End(3)(2, 1).CopyFromRecordset rs
rs.Close
con.Close
End If
End If
Next D
Set rs = Nothing: Set con = Nothing
Set evn = Nothing: Set klasor = Nothing: D = vbNullString
End Sub
Ekteki gibi bir kod satırıyla kapalı dosyalardaki verileri çekebiliyorum yalnız çekilen verilerin karşısına örneğin "M" sutununada çcekilen dosya ismini yazdırmak istiyorum. Yardımcı olabilirmisiniz. Tüm verilerin karşısına yazılacaktır.
Private Sub CommandButton2_Click()
On Error Resume Next
Dim con As Object, evn As Object, yol As String
Sayfa2.Range("a2:z65536").ClearContents
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.getfolder(ThisWorkbook.Path & "\Siparişler")
For Each D In klasor.Files
If D.Name <> ThisWorkbook.Name Then
If VBA.Right(D.Name, 4) = "xlsx" Or VBA.Right(D.Name, 3) = "xls" Then
con.Open " provider=microsoft.ace.oledb.12.0;data source=" & _
D.Path & ";extended properties=""excel 12.0;hdr=no"""
sorgu = "select f2,f3,f14,f15,f16,f17,f18 from [Birleştirilmiş$a6:r300]"
rs.Open sorgu, con, 1, 1
Sayfa2.Range("b65536").End(3)(2, 1).CopyFromRecordset rs
rs.Close
con.Close
End If
End If
Next D
Set rs = Nothing: Set con = Nothing
Set evn = Nothing: Set klasor = Nothing: D = vbNullString
End Sub