Kayıt Ederken Günü Tarihiyle Masaüstüne Yeni Klasör Açmak İstiyorum.

[gulevurgun]

Merhaba Arkadaşlar

Sağdaki butonlar siparişi geçen arkadaşlar için.Soldaki bu buton ise siparişi alan arkadaşlar için.Yapmak istediğim bu sol butona basıldığında siparişi yazdırması ve kayıt etmesi.Buraya kadar sorun yok.Kaydetme aşamasında günün tarihiyle masaüstüne bir klasör oluşturmalı örnek: 03.09.2008 - Gelen Siparişler diye bi kasör oluşturacak ve öle kayıt edicek.Ben hergün klasör açmamış olacağıım.Yardımlarınızı bekler, hayırlı çalışmalar dilerim.

 

[gulevurgun]

Güncelleme

 

[Ayhan Ercan]

Merhaba


Aşağıdaki kodu kendinize uyarlayınız...

Set ds = CreateObject("Scripting.FileSystemObject")
ds.CreateFolder "C:\Documents and Settings\demet.guzeller\Desktop\ardiye kesim\" & Date & "-Gelen Siparişler"

 

[gulevurgun]

Vermiş olduğunuz kod için teşekkür ederim.
Yalnız benim istediğim gibi günün tarihiyle klasör açıyor buraya kadar sorun yok.
Ama benim istediğim o günün tarihiyle açılan klasörün içine excel dosyasını kayıt etmesi gerekiyor.
Ve aynı gün o klasörünü içie 50 - 100 arasında sipariş kayıt etmem gerekiyor.Bu kod sadece o klasörü bir kere açmama izin veriyor.Klasör masaüstündeyken hata veriyor.
Benim İstediğim ben ilk sipariş için butona bastığımda o sayfanın çıktısını alacak günün tarihiyle klasör oluşturacak ve exceli kapatacak.
2 nci siparişte klasör olmuş olacak o klasörün içine kayıt etmesi gerekiyor

 

[gulevurgun]

Güncelleme

 

[Ayhan Ercan]

Merhaba

Aşağıdaki kodu deneyiniz...

Dim ds, dd, a
Set ds = CreateObject("Scripting.FileSystemObject")
Set dd = CreateObject("Scripting.FileSystemObject")
a = dd.FolderExists("C:\Documents and Settings\demet.guzeller\Desktop\ardiye kesim\" & Date & "-Gelen Siparişler")
If a = True Then GoTo 10
ds.createfolder "C:\Documents and Settings\demet.guzeller\Desktop\ardiye kesim\" & Date & "-Gelen Siparişler"
10 ChDir "C:\Documents and Settings\demet.guzeller\Desktop\ardiye kesim\" & Date & "-Gelen Siparişler"
ActiveWorkbook.SaveAs Filename:= _
Sheets("SİPARİŞ FORMU").Range("B38") & ".xls"

 

[gulevurgun]

Teşekkür ederim bu kod işimi gördü.İyi çalışmalar

 

[Ayhan Ercan]

Rica ederim.
İyi Çalışmalar.... k::

 

[gulevurgun]

Bu butona basınca benim pc gereken herşeyi olması gereken gibi yapıyor.Ama diğer pc kullanıcı adını değiştiriyorum masa üstüne günün tarihiyle klasör açıyo ama onun içine kayıt etmesi gerekirken gidiyor belgelerimin içine kayıt ediyor.

Olması gereken yoksa o günün tarihiyle klasör açacak ve B38 hücresindeki isim ve tarihle kayıt edip yazıcıdan çıktı alıp exceli kapatacak.Benim pc oluyor aa kullanaması gereken arkadaşın pc olmuyor.Belgelerime atıyor.Yardımlarnızı bekliyorm.
--------------------------------------------------------------
Sub Makro11()
Dim ds, dd, a
Set ds = CreateObject("Scripting.FileSystemObject")
Set dd = CreateObject("Scripting.FileSystemObject")
a = dd.FolderExists("C:\Documents and Settings\sengul.demir\Desktop\" & Date & "-Gelen Siparişler")
If a = True Then GoTo 10
ds.createfolder "C:\Documents and Settings\sengul.demir\Desktop\" & Date & "-Gelen Siparişler"
10 ChDir "C:\Documents and Settings\sengul.demir\Desktop\" & Date & "-Gelen Siparişler"
ActiveWorkbook.SaveAs Filename:= _
Sheets("SİPARİŞ FORMU").Range("B38") & " " & Format(Date, "- dd.mm.yyyy") & ".xls"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Application.Quit
End Sub

 

[gulevurgun]

Yardımlarınızı bekliyorum

 

[gulevurgun]

Bu butona basınca benim pc gereken herşeyi olması gereken gibi yapıyor.Ama diğer pc kullanıcı adını değiştiriyorum masa üstüne günün tarihiyle klasör açıyo ama onun içine kayıt etmesi gerekirken gidiyor belgelerimin içine kayıt ediyor.

Olması gereken yoksa o günün tarihiyle klasör açacak ve B38 hücresindeki isim ve tarihle kayıt edip yazıcıdan çıktı alıp exceli kapatacak.Benim pc oluyor aa kullanaması gereken arkadaşın pc olmuyor.Belgelerime atıyor.Yardımlarnızı bekliyorm.Örnek dosya bi üst yazımda ekli
--------------------------------------------------------------
Sub Makro11()
Dim ds, dd, a
Set ds = CreateObject("Scripting.FileSystemObject")
Set dd = CreateObject("Scripting.FileSystemObject")
a = dd.FolderExists("C:\Documents and Settings\sengul.demir\Desktop\" & Date & "-Gelen Siparişler")
If a = True Then GoTo 10
ds.createfolder "C:\Documents and Settings\sengul.demir\Desktop\" & Date & "-Gelen Siparişler"
10 ChDir "C:\Documents and Settings\sengul.demir\Desktop\" & Date & "-Gelen Siparişler"
ActiveWorkbook.SaveAs Filename:= _
Sheets("SİPARİŞ FORMU").Range("B38") & " " & Format(Date, "- dd.mm.yyyy") & ".xls"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Application.Quit
End Sub