kapalı dosyadan listbox bilgi alma

[ikikan]

Dim conn As Object
Dim rs As Object

Private Sub ComboBox1_Change()
ListBox1.RowSource = vbNullString
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 [ALIMLAR$];", conn, 1, 1
Range("A2").CopyFromRecordset rs
rs.Close
conn.Close
ListBox1.RowSource = "ALIMLAR!A2:U" & Sheets("ALIMLAR").Cells(65536, "A").End(xlUp).Row
End Sub

Private Sub UserForm_Initialize()
Dim fso As Object, fs As Object
ListBox1.ColumnWidths = "35;0;85;85;0;0;35;35;65;65;0;0;0;0;0;0;0;0;78;50"
'ListBox1.RowSource = "ALIMLAR!A2:T2" & Sheets("ALIMLAR").Range("A65536").End(xlUp).Row
Set fso = CreateObject("Scripting.FileSystemObject")
For Each fs In fso.getfolder(ThisWorkbook.Path & "\ARŞİV").Files
If Right(fs.Name, 4) = ".xls" Then
ComboBox1.AddItem Left(fs.Name, Len(fs.Name) - 4)
End If
Next
Set conn = CreateObject("ADODB.CONNECTION")
Set rs = CreateObject("ADODB.RECORDSET")

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set rs = Nothing
Set conn = Nothing
End Sub

bu kodu xlsx ve xlsm icin düzenlemek mümkünmüdür ?

 

[mancubus]

xlsx:

If Right(fs.Name, 5) = ".xlsx" Then

xlsm:

If Right(fs.Name, 5) = ".xlsm" Then

xlsx veya xlsm:

If Right(fs.Name, 5) = ".xlsx" or Right(fs.Name, 5) = ".xlsm" Then

 

[ikikan]

neden value degeri atıyamıyorum

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim baglanti As Object, yer As Object, sayfa As Object
Set baglanti = New ADODB.Connection
Set yer = New ADODB.Recordset


ListBox2.Clear
baglanti.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
ThisWorkbook.Path & "\KartP\" & ListBox1.Value & ".xlsx ;Extended Properties='Excel 12.0 Macro;HDR=YES';"
yer.Open "Select * From [Sayfa1$];", baglanti, 1, 1
With ListBox2
.AddItem
.ColumnCount = 1
.List(0, 0) = yer(0)
End With
Label1.Caption = ""
Label1.Caption = ListBox1.Value
yer.Close
baglanti.Close
End Sub