adı sabit olmayan bir dosyadan veri çekmek

[karakaçan]

Hayırlı sabahlar bir veri bankasından çektiğim verileri program adını kendi belirlediği excel dosyasına aktarıyor. Ben de bu excel dosyasından veri çekmek istiyorum. Bu siteden aldığım aşağıdaki kodu kullanmak istiyorum. Ancak veri çekeceğim dosyanın adı sabit değil. Bir mesaj kutusuna veri çekeceğim dosyanın adını girsem veya başka bir yöntemle bunu yapmam mümkün mü? Teşekkürler

Option Explicit

Sub VERİ_AL()
Dim Satır As Long, Sütun As Byte, Son_Satır As Long, Son_Sütun As Byte

Son_Satır = ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[Kitap1.xls]Sayfa1'!C1)")
Son_Sütun = ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[Kitap1.xls]Sayfa1'!R1)")

Range(Cells(1, 1), Cells(Son_Satır, Son_Sütun)).ClearContents

For Satır = 1 To Son_Satır
For Sütun = 1 To Son_Sütun
Cells(Satır, Sütun) = ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[Kitap1.xls]Sayfa1'!R" & Satır & "C" & Sütun & "")
Next
Next

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[muzos80]

merhaba ben aşağıdaki makroyu kullanıyorum işinize yarar ise

Private Sub CommandButton1_Click()

Dim sFolder As String

On Error Resume Next
Dim con As Object, evn As Object, yol As String, i As Byte
Sayfa1.Range("a5:z" & Rows.Count).ClearContents
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set evn = CreateObject("scripting.filesystemobject")

For i = 1 To 1

If sFolder = "" Then
Set Klasor = evn.GetFolder(KlasorSec(ThisWorkbook.Path))
Else
Set Klasor = evn.GetFolder(KlasorSec(sFolder))
End If


For Each D In Klasor.Files
If VBA.Right(D.Name, 4) = "xlsx" Or VBA.Right(D.Name, 4) = "xlsm" Then

con.Open " provider=microsoft.ace.oledb.12.0;data source=" & _
D.Path & ";extended properties=""excel 12.0;hdr=no"""
sorgu = "select * from [dosya sayfa ismi$a5:z30000] where f1<>' '"
rs.Open sorgu, con, 1, 1

Sayfa1.Range("a65536").End(3)(2, 1).CopyFromRecordset rs
rs.Close
con.Close

End If
Next D
Next

Set rs = Nothing: Set con = Nothing: i = Empty
Set evn = Nothing: Set Klasor = Nothing: D = vbNullString
MsgBox "Aktarma başarılı "

End Sub
Function KlasorSec(dosyayo1 As String)


With Application.FileDialog(msoFileDialogFolderPicker)

If sFolder = "" Then
.InitialFileName = dosyayol & "\\dosya konumu link yapıştır"
Else
.InitialFileName = sFolder & "\\dosya konumu link yapıştır"
End If
If .Show = -1 Then sFolder = .SelectedItems(1)
End With

If sFolder <> "" Then KlasorSec = sFolder


End Function

 

[Levent Menteşoğlu]

Dosyanızı aşağıdaki gibi seçerek bir değişkene atayabilirsiniz.

Dosya = Application.GetOpenFilename("Excel Dosyası (*.xlsx),*.xlsx", , "Veri alınacak Excel Dosyasını Seçin")
If Dosya <> False Then dosyaadi = Dosya
MsgBox dosyaadi

 

[karakaçan]

Sağolun çok teşekkür ederim.