- Katılım
- 2 Mart 2005
- Mesajlar
- 2,960
- Excel Vers. ve Dili
-
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Sub FolderExistsArsiv()
Dim TargetFolder As String
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
Set s3 = Sheets("devirler")
Set s4 = Sheets("Aylık")
Set fs = CreateObject("Scripting.FileSystemObject")
a = WorksheetFunction.Text(s1.Cells(1, 1), "yyyy")
b = WorksheetFunction.Text(s1.Cells(1, 1), "mmyyyy")
k_yol = ThisWorkbook.Path
k_ad = ThisWorkbook.Name
tarih = s1.Cells(1, 1)
'---------------Yıl
yol = ThisWorkbook.Path & "\" ' mevcut çalışma kitabının olduğu ve alt klasör açılacak yol
TargetFolder = yol & a ' Açılacak klasör adı ile birleşimi
If Not fs.FolderExists(TargetFolder) Then 'KONTROL
ChDir yol: MkDir a: MsgBox a & " Klasörü oluşturuldu.!" 'klasöre git, oluşturma mesajı ver
'farklı kaydet
ActiveWorkbook.SaveAs Filename:= _
yol & a & "\" & b & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
'kaydedileni kapat
'...........................
'Aynı dosyaya Dön
ChDir k_yol
Workbooks.Open Filename:= _
k_yol & "\" & k_ad
Else
MsgBox a & " Klasörü var!" 'var mesajı var
End If
End Sub
2) Farklı kaydet esnasında makroları ve a,b,b sayfaları hariç demenin yolu varmıdrı?
Saygılarımla