Otomatik tarih klasörü oluşturma

[burak80li]

Arkadaşlar merhaba,
İşyerinde kullandığımız excel dosyasında bir takım değişiklikler yaptıktan sonra günde bir kaç kez kayıt yapıyoruz. Sizlerden aldığım yardımlarla sadece aktif olan sheet i belli bir hücrenin ismiyle [hücreiçeriği].xls olarak kaydetmeyi başardım.
Fakat istedigim birşey daha var. Ben otomatik olarak bu aya ait klasör oluşturmayı ve bugünün tarihi ne ise dosyanın o aya ait klasöre kopyalanmasını istiyorum.
Dosyayı gönderemem beni anlayışla karşılayacağınızı ümit ediyorum.
Tek istedigim mkdir ile bu aya ait klasörü otomatik nasıl oluşturabilirim onu öğrenmek. Mesela bugünün tarihi 2 eylül 2008. ben kaydet derken excel c:/eylül2008 diye klasör oluşturacak. Ve eylül ayında yaptığım her işi buraya kaydedecek. Ekim geldiginde , ben o excel dosyasında bir kayıt yapınca otomatik c:/ekim2008 klasörü oluşturacak ve ben otomatik oraya kayıt yapacağım (kayıt meselesi önemli degil. Onu yaparım. sadece klasörü oluşturmayı öğrenmek istiyoum.) Böylece aradığımız dosyayı rahat bulacağız.

Şimdiden teşekkür ederim

 

[ersoyalan]

PArkadaşım merhaba deneme fırsatım olmadı fakat işini görebilir.Kodları denermisin.

rivate Sub CommandButton3_Click()
Dim dsy
dsy = InputBox("Lütfen LEAD TIME'a ait ayın adını giriniz?", "Lead Time Dosyası Oluşturma", Format(Now, "mmmm_yyyy"))
If dsy = Cancel Then Exit Sub
On Error GoTo 10
MkDir "C:\LEAD TİME\" & dsy
Set NewBook = Workbooks.Add
With NewBook
.SaveAs "C:\LEAD TİME\" & dsy & "\" & "Lead_time_" & dsy & ".xls"
End With
Windows("LEAD TİME.xls").Activate
Cells.Select
Selection.Copy
Windows("Lead_time_" & dsy & ".xls").Activate
ActiveSheet.Paste
Range("A2").Select
Range("Z1:AG9").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A2").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("LEAD TİME.xls").Activate
Range("A2").Select
ActiveWorkbook.Save
Unload UserForm1
Exit Sub
10:
MsgBox "Dosya ismini kontrol edip tekrar deneyiniz.", vbExclamation, "UYARI!!!!!!!"
End Sub

 

[Necdet]

Merhaba,

Ben olsam önce 2008 diye bir Dizin Oluştururum.
onun altına da:
2008-01
2008-02
2008-03
.
.
.
vs diye alt dizin oluştururum.
Alfabetik sırada dizin bulmak zordur.

Bu mantıkla Önce Yıl için dizin oluşturmayı, sonrada aylara göre alt dizin oluşturma örneğini inceleyiniz.

Sub DizinOlustur()
On Error Resume Next
MkDir "C:\" & Year(Date)
MkDir "C:\" & Year(Date) & "\" & Year(Date) & "-" & Format(Month(Date), "00")
End Sub

 

[burak80li]

Arkadaşlar teşekkür ediyorum inceliyorum ikisini de..
.....................
....................

Necdet arkadaşım denedim. TAm istedigim gibi bir makro. Çok teşekkür ederim.
Ersoyalan arkadaşım sana da teşekkür ediyorum. Kısa olduğu için Önce Necdet arkadaşımızın ki denemiştim. Sizinkini de inceliyorum..

 

[burak80li]

Arkadaşlar işi halletmiştik ama bir problem çıktı

Run Time Error '75'
Path/File Access Error

hatası veriyor. Benim zannımca zaten var olan 2008 klasörünü tekrar oluşturmaya çalıştığı için hata veriyor. EGer 2008 diye bir klasör varsa sub dan çıkması lazım. Bunu nasıl yaparız?

 

[Necdet]

Merhaba,

Bence başka birşey var.
Kodun içindeki On Error Resume Next ibaresi bir hata olduğunda atla demektir.

Eğer benim kodlarımdan sözediyorsanız.

 

[burak80li]

Necdet hocam tamamdır.
her nasılsa "On Error Resume Next" ı silmişim. ONu ekleyince düzeldi..

Peki bir şey soracağm. Şu şekilde de olurmu?

If Dir(yol) <> "" Then ' yol bilgisayara kaydedecegimiz yer oluyor

klasor ' Bu sizin verdiginiz kod. (Klasor isimli Sub)

Else
ChDir yol

End If