...Sub Yedekle()
Dim Yol As String, Sayfa As Worksheet
Yol = Environ("username") & "\Desktop"
If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
MsgBox "İşlemi...
...işinizi görürmü?
Option Explicit
Sub Yedekle()
Dim Yol As String, Sayfa As Worksheet
Yol = "c:\Yedek"
If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
MsgBox "İşlemi iptal ettiniz!"...
...& "Üretim Vardiya Raporları" & Application.PathSeparator
If Dir(Yol, vbDirectory) = "" Then
Shell ("cmd /c mkdir """ & Yol & """")
End If
End Sub
2. Alternatif;
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib...
...şekide istersen kodun sonuna &Application.PathSeparator eklersin.
Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
Application.PathSeparator & "Üretim Vardiya Raporları"
If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)
On Error Resume Next
....................
...= dosya & Format(Now, " dd_mm_yyyy hh_mm") & uzanti
Kayıt_Yeri = yer & Yedek_Dosya_Adı
On Error Resume Next
If Dir(yer) = "" Then MkDir yer
On Error Resume Next
DosyaSistemi.CopyFile ThisWorkbook.FullName, Kayıt_Yeri
ActiveWorkbook.Password = ""
Application.DisplayAlerts = True...
...Dim i As Integer
strFolderName = ThisWorkbook.Path & "\YEDEK\"
If Dir(strFolderName, vbDirectory) = "" Then
MkDir strFolderName
End If
strDate = Format(Date, "dd.mm.yyyy")
Set wb = ThisWorkbook
For i = 5 To wb.Worksheets.Count...
...' Yeni bir klasör oluştur
YeniKlasor = DosyaYolu & "\AYIR"
If Dir(YeniKlasor, vbDirectory) = "" Then
MkDir YeniKlasor
End If
' Tüm sayfaların listesini göster
Dim SayfaListesi As String
Dim i As Integer
SayfaListesi = "Lütfen kaydedilecek...
...DosyaYolu = ActiveWorkbook.Path
YeniKlasor = DosyaYolu & "\AYIR"
If Dir(YeniKlasor, vbDirectory) = "" Then
MkDir YeniKlasor
End If
Dim SayfaListesi As String
Dim i As Integer
SayfaListesi = "Lütfen kaydedilecek sayfaların numaralarını virgülle...
...= Range("B1:B100")
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub
...olacaktır.
Altenatif olarak aşağıdaki gibi kullanabilirsiniz.
Private Sub Workbook_Open()
If Dir("C:\Deneme", vbDirectory) = "" Then MkDir "C:\Deneme"
If VBA.Dir("C:\Deneme\Kontrol.txt") = "" Then
Set Dosya =...
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.