Comboboxla kapalı dosyadan veri alma

[zfr10]

Selam arkadaşlar. Site üzerinde epey araştırdım fakat konumla ilgili tam birşey bulamadım. Çalışmış olduğum kurumda sürekli klasör içerisinde dosyalar oluşturuyorum. Fakat her yıla ait farklı klasörler var. Ben de ana dosya üzerinden combobox yardımıyla istenilen klasör ve istenilen dosyadan veri almak istiyorum. Ekteki ana ebat sayfamdaki sarı renkli alanlara göre kapalı dosyalardan veri almak konusunda yardım edebilir misiniz?

 

[zfr10]

Arkadaşlar yardım edebilir misiniz?

 

[ÖmerBey]

Merhaba,
Userforma aşağıdaki kodları kopyalayıp deneyiniz...

Private Sub KlasorBul(Yol As String)
Dim fL As Object, f As Object, j As String
On Error Resume Next
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).SubFolders
On Error GoTo sonraki
For Each f In fL
ComboBox1.AddItem f.Path
sonraki:
On Error Resume Next
KlasorBul (f.Path)
Next
Set fL = Nothing
End Sub


Private Sub ComboBox1_Change()
ComboBox2.Clear
Yol = ComboBox1.Value & "\"
DSY = Dir(Yol, vbNormal)
Do While DSY <> ""
If (GetAttr(Yol & DSY) And vbNormal) = vbNormal Then
ComboBox2.AddItem DSY
End If
DSY = Dir
Loop
End Sub

Private Sub ComboBox2_Change()
If ComboBox2.Value = "" Then Exit Sub
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dosya = ComboBox1.Value & "\" & ComboBox2.Value
Set s1 = ThisWorkbook.Sheets("EBAT")
Set w1 = Workbooks.Open(Dosya)
Set s2 = w1.Sheets(1)
Set alan = s1.Range("C6,M5,C8,E8,G8,I8,K8,M8,O8,A10:A47,C10:C47,E10:E47,G10:G47,I10:I47,K10:K47,M10:M47,O10:O47,L51,M53,E53")
For Each hcr In alan
    hcr.Value = ""
    hcr.Value = s2.Range(hcr.Address)
Next
w1.Close 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
KlasorBul (ThisWorkbook.Path & "\")
End Sub

 

[zfr10]

Eline, yüreğine, emeğine, bileğine sağlık Mucit77 üstadım. İnan nasıl teşekkür edeceğimi bilmiyorum. ALLAH razı olsun. Saygılarımı sunarım...