Klasördeki Dosyaların Açılması

[1Al2Ver]

Günaydın arkadaşlar,

Masaüstünde ŞİRKET isimli klasörde 5 ader dosyam var, isimleri Sebze, Meyva,Bakliyat,Kahvaltılık ve Tetkik,

Bu dosyalardan herhangi bir tanesini ( örn;Meyva) açtığımda diğerlerinin de açılmasını sağlayacak yada ŞİRKET isimi klasöre tıkladığımda hepsini açabilen kodu rica ediyorum,

Teşekkür ederim.

 

[halit3]

bu kodu denermisin tabi dosyanın yerini bulman lazım


Sub ac()
Dim Dosya As String
Dim wb As Workbook
On Error Resume Next
Application.DisplayAlerts = False
Set Objfolder = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör Seçiniz...", &H4, "")
Kaynak = Objfolder.items.Item.Path
If Kaynak = "" Then
MsgBox "veri yok veya Kaynak Klasör Seçimi yapılmadı !", vbInformation, "DİKKAT"
Exit Sub
End If
Dosya = Dir(Kaynak & "\*.xls")
While Dosya <> ""
Set wb = Workbooks.Open(Kaynak & "\" & Dosya)
Dosya = Dir
'wb.Close False
Wend
End Sub

 

[fedeal]

altarnatif olsun,

Sub auto_open()
dosya_yolu = "[COLOR="Red"]C:\Documents and Settings\Gerekli Xp\Desktop\ŞİRKET\[/COLOR]"
If Not WorkbookOpen(dosya_yolu & "Sebze.xls") Then
    Workbooks.Open dosya_yolu & "Sebze.xls"
End If
If Not WorkbookOpen(dosya_yolu & "Meyva.xls") Then
    Workbooks.Open dosya_yolu & "Meyva.xls"
End If
If Not WorkbookOpen(dosya_yolu & "Bakliyat.xls") Then
    Workbooks.Open dosya_yolu & "Bakliyat.xls"
End If
If Not WorkbookOpen(dosya_yolu & "Kahvaltılık.xls") Then
    Workbooks.Open dosya_yolu & "Kahvaltılık.xls"
End If
If Not WorkbookOpen(dosya_yolu & "Tetkik.xls") Then
    Workbooks.Open dosya_yolu & "Tetkik.xls"
End If
End Sub
Function WorkbookOpen(WorkBookName As String) As Boolean
    WorkbookOpen = False
    On Error GoTo WorkBookNotOpen
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
        WorkbookOpen = True
        Exit Function
    End If
WorkBookNotOpen:
End Function

dosya yolunu düzeltin modüllerine kopyalayın.dosyalara açıkmı bakar açık degilse açar.Kodlar kod arşivimizden alıntı ve uyarlamadır.iyi çalışmalar.

 

[1Al2Ver]

bu kodu denermisin tabi dosyanın yerini bulman lazım


Sub ac()
Dim sd As VBComponent
Dim kodlar As CodeModule
Dim Dosya As String
Dim wb As Workbook
On Error Resume Next
Application.DisplayAlerts = False
Set Objfolder = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör Seçiniz...", &H4, "")
pth = Objfolder.items.Item.path
Dosya = Dir(pth & "\*.xls")
While Dosya <> ""
Set wb = Workbooks.Open(pth & "\" & Dosya)
Dosya = Dir
'wb.Close False
Wend
End Sub

Sayın halit3 merhaba,

Öncelikle cevap için teşekkür ederim,

Kodu, klasördeki hangi dosyaya ve nereye (Örn;modüle mi) kopyalamam gerekiyor ?

Denemem şöyle oldu ;

Kodu, klasördeki değişik dosyalarda modül1'e kopyaladım (hata mesajı aldım)

Açıklarsanız memnun olurum, teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Alternati olarak aşağıdaki koduda kullanabilirsiniz. Klasör altındaki her dosyanın içine eklerseniz her dosyayı açmak istediğinizde diğer dosyalarda otomatik olarak açılacaktır. Uzantıları "xls" ve "doc" olan dosyalar açılacaktır.

Option Explicit
 
Sub AUTO_OPEN()
    Dim DOSYA_YOLU As String, KİTAP As String
    
    DOSYA_YOLU = ThisWorkbook.Path & "\"
    
    If CreateObject("Scripting.FileSystemObject").GetFolder(DOSYA_YOLU).Files.Count = 0 Then GoTo Son
    KİTAP = Dir(DOSYA_YOLU)
    While KİTAP <> ""
        If Right(KİTAP, 3) = "xls" Or Right(KİTAP, 3) = "doc" Then
        CreateObject("Shell.Application").Open DOSYA_YOLU & KİTAP
        End If
    KİTAP = Dir
    Wend
    
    Exit Sub
Son:
End Sub

 

[1Al2Ver]

Sayın fedeal merhaba,

Çözüm için teşekkür ederim, saygılarımla.

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

Çözüm için teşekkür ederim, saygılarımla.

 

[halit3]

Sayın halit3 merhaba,

Öncelikle cevap için teşekkür ederim,

Kodu, klasördeki hangi dosyaya ve nereye (Örn;modüle mi) kopyalamam gerekiyor ?

Denemem şöyle oldu ;

Kodu, klasördeki değişik dosyalarda modül1'e kopyaladım (hata mesajı aldım)

Açıklarsanız memnun olurum, teşekkür ederim.

kodu yeniden düzenledim bir modül içene alın ve çalıştırın

 

[1Al2Ver]

kodu yeniden düzenledim bir modül içene alın ve çalıştırın

Sayın halit3 merhaba,

Çözüm için teşekkür ederim, saygılarımla.