sheet ismindeki yıla göre klasör açmak ve veri kaydetmek

[zulfuernek]

Sub PDF()
Dim ds, cs As Object
Dim gds
Set cs = CreateObject("Scripting.FileSystemObject")
Set ds = CreateObject("WScript.Shell")
gds = ds.SpecialFolders("Desktop")

If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\"
ChDir gds & "\KASA YEDEKLERİ\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub

yukarıdaki kodla masaüstünde KASA YEDEKLERİ olarak klasör açıyor ve sheetleri kendi ismiyle pdf formatına çevirerek kaydediyor. eğer aynı isimde pdf varsa uyarı vermeden kaydediyor. bunda problem yok.

sorum şu. KASA YEDEKLERİ KLASÖRÜ nü açtı ve sheetleri kendi ismiyle kaydederken sheetin ismi örneğin 13.06.2017 bunu KASA YEDEKLERİ klasörü içerisine sheetin yılı 2017 ise 2017 adında klasör açması ve bu sheeti onun içine kaydetmesi. eğer sheet örneğin 09.12.2019 ise shetteki 2019 yılını baz alarak 2019 adında KASA YEDEKLER içerisine bir klasör daha oluştursun ve yeni yıla ait sheeti onun içerisine kaydetsin.

 

[zulfuernek]

buradaki amaç şu. ben 2017 yılına ait pdf olarak kaydedilmiş verileri ile daha sonraki yıllara ait oluşacak pdf verilerinin ayrı ayrı klasörde olmasını istiyorum. mümkünmüdür? döngü sonsuz olarak devam etmeli. hangi yılda isek KASA YEDEKLERİ içerisine o yıla ait klasör oluşturması o yıla ait pdfleri onun içerisine kaydetmeli

 

[PLİNT]

Merhaba
Aktif sayfa adında bulunan yıl için aşağıdaki değişiklikle olabilir;

[SIZE="2"]Sub PDF()
Dim ds, cs As Object
Dim gds
[COLOR="Blue"]Dim dosya As String[/COLOR]
Dim yıl As Integer
Set cs = CreateObject("Scripting.FileSystemObject")
Set ds = CreateObject("WScript.Shell")
gds = ds.SpecialFolders("Desktop")

If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\"

If IsDate(ActiveSheet.Name) = True Then
yıl = Year(ActiveSheet.Name)
If cs.FolderExists(gds & "\KASA YEDEKLERİ\" & yıl) = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & yıl

Else
MsgBox "AKTİF SAYFA ADINDA SORUN VAR"
Exit Sub
End If

[COLOR="Blue"]dosya = gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.Name & ".pdf"
If cs.FileExists(dosya) = True Then Kill dosya[/COLOR]

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

End Sub[/SIZE]

 

[PLİNT]

İçinde bulunulan yıl için;

[SIZE="2"]Sub PDF()
Dim ds, cs As Object
Dim gds
Dim yıl As Integer
Set cs = CreateObject("Scripting.FileSystemObject")
Set ds = CreateObject("WScript.Shell")
gds = ds.SpecialFolders("Desktop")

If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\"

yıl = Year(Date)
If cs.FolderExists(gds & "\KASA YEDEKLERİ\" & yıl) = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & yıl


ChDir gds & "\KASA YEDEKLERİ\" & yıl & "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub[/SIZE]

 

[zulfuernek]

hocam ilk kod oldu sanırım ancak bir sorun var
hangi yılın sjhhetiyse klasörü açıyor ve o yılın verilerini o klasöre kaydediyor
ancak ilk kaydederken sorun yok ama aynı shheti değişiklik yapıp kaydederken aynı isimdeki pdf olduğu için hata veriyor

hata verdiği kod kısmı son kısımlar. aşağıdaki kod yani

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

 

[PLİNT]

Merhaba
Bende hata vermedi ama
yukarıda (3.mesaj) daki kodlara varsa aynı isimli dosyayı silen bölüm eklendi.

 

[zulfuernek]

plint hocam 2. güncellediğiniz şekilde kod oldu. buradaki en sonda bulunan pdf yi aç komutunu false yapınca olay düzeldi. malum pdf açıkken dosya (olurya) isim değişikliği yapmadığından olayı false ile aınlandırdım. ama tam istediğim gibi hangi yıla aitse klasörünü açıyor ve o yıla ait veriyi içerisine atıyor. emeğine sağlık