Listbox'tan Dosya Adını Seçerek Kapalı Dosyanın Açılması

[ahmed_ummu]

Günaydın arkadaşlar.

Aşağıdaki kod ile masaüstünde bulunan STAJYER_ÖĞRENCİ_PUANTAJLARI isimli klasörün içinde bulunan Excel dosyalarının isimlerini Listbox'a listeliyor.

Private Sub UserForm_Initialize()
Set fso = VBA.CreateObject("scripting.filesystemobject")
yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\STAJYER_ÖĞRENCİ_PUANTAJLARI\"
For Each kls In fso.getfolder(yol).Files
ListBox4.AddItem fso.getbasename(kls.Name)
Next kls
End Sub

Aşağıdaki kod ile de Listbox'taki listelenen Excel dosyalarının herhangi birine tıklandığında ismi tıklanan dosyanın açılması gerekiyor. Ama dosya bulunamadı diye hata veriyor. Nerede hata var yardımcı olabilir misiniz.

Application.Workbooks.Open "Destkop" & "\" & "STAJYER_ÖĞRENCİ_PUANTAJLARI" & "\" & ListBox4.Value

 

[DoğanD]

Merhaba,

En alttaki satırın sonuna & ".xlsx" ekleyip dener misiniz? Tabii bu dosya Excel ise yada sürümü ".xlsx" ise.

Application.Workbooks.Open "Destkop" & "\" & "STAJYER_ÖĞRENCİ_PUANTAJLARI" & "\" & ListBox4.Value & ".xlsx"

 

[ahmed_ummu]

Merhaba,

En alttaki satırın sonuna & ".xlsx" ekleyip dener misiniz? Tabii bu dosya Excel ise yada sürümü ".xlsx" ise.

Application.Workbooks.Open "Destkop" & "\" & "STAJYER_ÖĞRENCİ_PUANTAJLARI" & "\" & ListBox4.Value & ".xlsx"

Sayın DoğanD yine aynı hatayı verdi.

Dosya Türü : Microsoft Excel 97-2003 Çalışma Sayfası (.xls) Böyle de denedim. Yine hata verdi.

 

[DoğanD]

Yol kısmını kaçırmışım. Dosya yolunu tek başına Destkop olarak belirtemezsiniz. Çünkü aslında o yol gerçekte "C:\Users\dogan.dulger\Desktop" gibi görünüyor. Aşağıdaki gibi dener misiniz?

Application.Workbooks.Open "C:\Users\" & Environ("UserName") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.Value & ".xlsx"

 

[ahmed_ummu]

Yol kısmını kaçırmışım. Dosya yolunu tek başına Destkop olarak belirtemezsiniz. Çünkü aslında o yol gerçekte "C:\Users\dogan.dulger\Desktop" gibi görünüyor. Aşağıdaki gibi dener misiniz?

Application.Workbooks.Open "C:\Users\" & Environ("UserName") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.Value & ".xlsx"

Sayın DoğanD ilginiz için teşekkür ederim son gönderdiğiniz kod ile düzeldi.

 

[DoğanD]

O halde şöyle yapalım; Açmaya çalıştığınız Excel dosyasının üzerine Sağ Tıklayın ve Özellikler'e giriş yapın. Konum kısmında yazan ile, ekrana gelen hatadaki konumları karşılaştırın. Dosya uzantınızı kontrol edin ve ona göre değişiklikleri yapın. Problem kodda değil, aradığınız dosyanın, arama kriterleriniz ile uyuşmamasında.

 

[dEdE]

Dener misiniz?
Application.Workbooks.Open Environ("UserProfile") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.List(ListBox4.ListIndex, 0)

 

[ahmed_ummu]

O halde şöyle yapalım; Açmaya çalıştığınız Excel dosyasının üzerine Sağ Tıklayın ve Özellikler'e giriş yapın. Konum kısmında yazan ile, ekrana gelen hatadaki konumları karşılaştırın. Dosya uzantınızı kontrol edin ve ona göre değişiklikleri yapın. Problem kodda değil, aradığınız dosyanın, arama kriterleriniz ile uyuşmamasında.

Ekli dosyayı görüntüle 250759

Son gönderdiğiniz kod ile çalıştı sayın DoğanD teşekkürmederim.

 

[ahmed_ummu]

Dener misiniz?
Application.Workbooks.Open Environ("UserProfile") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.List(ListBox4.ListIndex, 0)

Teşekkürler sayın dEdE sizin gönderdiğiniz kod ile de çalıştı.

 

[ahmed_ummu]

Arkadaşlar kusura bakmayın. Bir soru daha soracağım. Yardımcı olduğunuz konunun devamı.

Aşağıdaki kodlar ile açılan dosyadaki A2:AK sütunlarını Bsütununu varsayarak son dolu satıra kadar kopyalıyor ve kopyalanan bu verileri SÖP sayfasının A7 hücresinden itibaren yapıştırması gerekiyor. Ama en alttaki kırmızı renkli satırı seçip, "Range sınıfının PasteSpecial yöntemi başarısız" diye hata veriyor. Bunun için de yardım edebilir misiniz.

Application.Workbooks.Open "C:\Users\" & Environ("UserName") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.Value
dosya_adi = ListBox4.Value
Dim say As Integer
Dim Sayfa As Worksheet
Set Sayfa = Worksheets("dışarıstj")
say = Sayfa.Cells(Sayfa.Rows.Count, "B").End(xlUp).Row
If say < 2 Then
MsgBox "Lütfen önce puantajı oluşturunuz.", vbCritical
Exit Sub
End If
Sayfa.Range("a2:Ak" & say).Copy
Application.Workbooks(dosya_adi).Close SaveChanges:=True
Sheets("SÖP").Range("B7").PasteSpecial xlPasteValues

 

[dEdE]

Kırmızı satırla üstündeki satırı yer değiştirerek dener misiniz.

Sayfa.Range("a2:Ak" & say).Copy
Sheets("SÖP").Range("B7").PasteSpecial xlPasteValues
Application.Workbooks(dosya_adi).Close SaveChanges:=True