• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Mevcut Aya göre klasör açma

  • Konbuyu başlatan Konbuyu başlatan sratacc
  • Başlangıç tarihi Başlangıç tarihi
S

sratacc

Katılım
23 Şubat 2012
Mesajlar
105
Excel Vers. ve Dili
2010
Değerli arkadaşlar selamlar.
Aradığım kod, şu anda bulunulan aya göre belirli bir konumdaki klasörü açacak kod.
Örn. şuanda mart ayında olduğumuz için, N:\AAA\BBB\2017\3_MART
yolundaki 3_mart klasörünün açılması
 
filesystemobject nesnesini inceleyiniz.
 
Aşağıdaki kodlar sanırım işinizi görür. Ben mevcut dosya yoluna oluşturdum. Siz
Dosya_Yolu = ThisWorkbook.Path & "\" '"N:\AAA\BBB\2017\" kısmındaki ThisWorkbook.Path & "\" ' kısmı silin.

[/code]
Option Explicit

Sub ASKM__Klasör_Olustur()
Dim X As Integer, Dosya_Adı As String
Dim Dosya_Yolu As String, Dosya_Sistemi As Object


Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")

Dosya_Yolu = ThisWorkbook.Path & "\" '"N:\AAA\BBB\2017\"
Dosya_Adı = Format(Now(), "m mmmm")
If Not Dosya_Sistemi.FolderExists(Dosya_Yolu) Then
Dosya_Sistemi.CreateFolder (Dosya_Yolu)
End If

If Not Dosya_Sistemi.FolderExists(Dosya_Adı) Then
Dosya_Sistemi.CreateFolder (Dosya_Adı)
End If

Set Dosya_Sistemi = Nothing

MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "ASERIN"
End Sub
[/code]
 
askm' Alıntı:
Aşağıdaki kodlar sanırım işinizi görür. Ben mevcut dosya yoluna oluşturdum. Siz
Dosya_Yolu = ThisWorkbook.Path & "\" '"N:\AAA\BBB\2017\" kısmındaki ThisWorkbook.Path & "\" ' kısmı silin.

[/code]
Option Explicit

Sub ASKM__Klasör_Olustur()
Dim X As Integer, Dosya_Adı As String
Dim Dosya_Yolu As String, Dosya_Sistemi As Object


Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")

Dosya_Yolu = ThisWorkbook.Path & "\" '"N:\AAA\BBB\2017\"
Dosya_Adı = Format(Now(), "m mmmm")
If Not Dosya_Sistemi.FolderExists(Dosya_Yolu) Then
Dosya_Sistemi.CreateFolder (Dosya_Yolu)
End If

If Not Dosya_Sistemi.FolderExists(Dosya_Adı) Then
Dosya_Sistemi.CreateFolder (Dosya_Adı)
End If

Set Dosya_Sistemi = Nothing

MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "ASERIN"
End Sub
[/code]
Genişletmek için tıkla ...

Hocam beceremedim, istedigim mart ayindayken 3_mart klasorunu nisan ayinda 4_nisan klasorunu acacak seklinde tum yilda calisabilecek kod
 
Ektedir.ASKM__Klasör_Olustur mevcut excel çalışmanızın altına klasör açar.
ASKM__Klasör_Olustur_2 sizin belirttiğiniz yola klasör açar.
 

Ekli dosyalar

Merhaba
Amacınız klasör oluşturma değilde; mevcut klasörü açmak ise aşağıdaki gibi deneyin
Kod: 
Private Sub CommandButton1_Click()

Set ds = CreateObject("Scripting.FileSystemObject")
If ds.FolderExists("N:\AAA\BBB\2017\3_MART") = True Then
aç = Shell("Explorer.exe N:\AAA\BBB\2017\3_MART", vbNormalFocus)
Else
MsgBox "KLASÖR BULUNAMADI"
End If

End Sub
 
Aşağıdaki kod ile hem klasör yoksa oluşturur var ise de klasörü açar.
Kod: 
Option Explicit
 
Sub ASKM__Klasör_Olustur()
    Dim X As Integer, Dosya_Adı As String
    Dim Dosya_Yolu As String, Dosya_Sistemi As Object
    
 
    Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")
 
    Dosya_Yolu = ThisWorkbook.Path & "\"  '"N:\AAA\BBB\2017\"
    Dosya_Adı = Format(Now(), "m mmmm")
    If Not Dosya_Sistemi.FolderExists(Dosya_Yolu) Then
        Dosya_Sistemi.CreateFolder (Dosya_Yolu)
    End If
 
    If Not Dosya_Sistemi.FolderExists(Dosya_Adı) Then
          Dosya_Sistemi.CreateFolder (Dosya_Adı)
    End If
    Dim ac
    
    CreateObject("Shell.Application").Open (Dosya_Yolu & Dosya_Adı)
    Set Dosya_Sistemi = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Galiba tam olarak anlasilamadim, ben klasor olusturmak istemiyorum,
Aylara gore mevcut bulunan klasorleri actirmak istiyorum.
N:\AAA\BBB\2017 yolu altinda 1_OCAK, 2_SUBAT, 3_MART…. seklinde devam eden klasorler mevcut,
Mart ayinda oldugumuz icin yol altindaki 3_mart klasorunu nisan ayina geldiginde de 4_NISAN klasorunu acmasini istiyorum
 
Şöyle deneyin
Kod: 
Private Sub CommandButton1_Click()
ay = Month(Date)
ay1 = Format(Date, "m")
ay2 = Format(Date, "mmmm")
yıl = Format(Date, "yyyy")
Set ds = CreateObject("Scripting.FileSystemObject")
If ds.FolderExists([COLOR="Red"]"N:\AAA\BBB\" & [COLOR="Blue"]yıl[/COLOR] & "\" & ay1 & "_" & ay2[/COLOR]) = True Then
aç = Shell("Explorer.exe [COLOR="Red"]N:\AAA\BBB\" & [COLOR="Blue"]yıl[/COLOR] & "\" & ay1 & "_" & ay2[/COLOR], vbNormalFocus)
Else
MsgBox "KLASÖR BULUNAMADI"
End If

End Sub
 
Hocam zahmet veriyorum ama calismiyor, klasor bulunamadi uyarisi verdi, bilgisayar sistem saatine gore mart ayi oldugundan 3 Mart klasorunu acmaliydi ama acmadi
 
Klasör adı "3 Mart" şeklinde ise açmaz mesajınızda "3_Mart" gibi alt tire vardı
"N" diski doğru değilmi?
Aşağıdaki kodda mesajla aradığı klasör yolunu bildirecektir deneyin (alt tire yok)
Kod: 
Private Sub CommandButton1_Click()
ay = Month(Date)
ay1 = Format(Date, "m")
ay2 = Format(Date, "mmmm")
yıl = Format(Date, "yyyy")
Set ds = CreateObject("Scripting.FileSystemObject")
MsgBox "[COLOR="Red"]N[/COLOR]:\AAA\BBB\" & yıl & "\" & ay1 & ay2
If ds.FolderExists("[COLOR="Red"]N[/COLOR]:\AAA\BBB\" & yıl & "\" [COLOR="Red"]& ay1 & ay2)[/COLOR] = True Then
aç = Shell("Explorer.exe [COLOR="Red"]N[/COLOR]:\AAA\BBB\" & yıl & "\"[COLOR="Red"] & ay1 & ay2[/COLOR], vbNormalFocus)
Else
MsgBox "KLASÖR BULUNAMADI"
End If

End Sub
 
PLİNT' Alıntı:
Klasör adı "3 Mart" şeklinde ise açmaz mesajınızda "3_Mart" gibi alt tire vardı
"N" diski doğru değilmi?
Aşağıdaki kodda mesajla aradığı klasör yolunu bildirecektir deneyin (alt tire yok)
Kod: 
Private Sub CommandButton1_Click()
ay = Month(Date)
ay1 = Format(Date, "m")
ay2 = Format(Date, "mmmm")
yıl = Format(Date, "yyyy")
Set ds = CreateObject("Scripting.FileSystemObject")
MsgBox "[COLOR="Red"]N[/COLOR]:\AAA\BBB\" & yıl & "\" & ay1 & ay2
If ds.FolderExists("[COLOR="Red"]N[/COLOR]:\AAA\BBB\" & yıl & "\" [COLOR="Red"]& ay1 & ay2)[/COLOR] = True Then
aç = Shell("Explorer.exe [COLOR="Red"]N[/COLOR]:\AAA\BBB\" & yıl & "\"[COLOR="Red"] & ay1 & ay2[/COLOR], vbNormalFocus)
Else
MsgBox "KLASÖR BULUNAMADI"
End If

End Sub
Genişletmek için tıkla ...

Hocam elinize saglik sorunsuz calisiyor tesrkkur ederim.
 
sratacc' Alıntı:
Hocam elinize saglik sorunsuz calisiyor tesrkkur ederim.
Genişletmek için tıkla ...
Rica ederim, kolay gelsin.
Mesaj bölümünü silersiniz.
Kod: 
MsgBox "N:\AAA\BBB\" & yıl & "\" & ay1 & ay2
Belirmemişiz; "3" ile "Mart" arasında boşluk varsa
Kod: 
If ds.FolderExists("N:\AAA\BBB\" & yıl & "\" & ay1[COLOR="Red"] & " " & [/COLOR] ay2) = True Then
aç = Shell("Explorer.exe N:\AAA\BBB\" & yıl & "\" & ay1[COLOR="Red"] & " " & [/COLOR]ay2, vbNormalFocus)
 
PLİNT' Alıntı:
Rica ederim, kolay gelsin.
Mesaj bölümünü silersiniz.
Kod: 
MsgBox "N:\AAA\BBB\" & yıl & "\" & ay1 & ay2
Belirmemişiz; "3" ile "Mart" arasında boşluk varsa
Kod: 
If ds.FolderExists("N:\AAA\BBB\" & yıl & "\" & ay1[COLOR="Red"] & " " & [/COLOR] ay2) = True Then
aç = Shell("Explorer.exe N:\AAA\BBB\" & yıl & "\" & ay1[COLOR="Red"] & " " & [/COLOR]ay2, vbNormalFocus)
Genişletmek için tıkla ...

Anlattiginiz sekilde yapmistim zaten hocam tesekkurler iyi gunler dilerim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst