İstenen İsimde Klasör Yoksa oluştursun

[sbayyigit]

Merhaba Arkadaşlar.
Oluşturduğum dosyayı farklı kaydediyorum. fakat bazı bilgisayarlarda istediğim isimde klasör olmadığı için kaydediyormuş gibi oluyor fakat dosya kaydedilmiyor.
Sizden ricam farklı kaydetmek istediğimde hedef klasör yoksa istenen sürücüde Kemal isminde bir klasör oluşturduktan sonra dosyayı kaydetsin.
şimdiden teşekkürler.

Sub farkli_Kaydet()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
Dim birim, tarih, dosya_adi As String
On Error Resume Next
birim = s1.Range("b1").Value
malzeme = s1.Range("e6").Value
tarih = s1.Range("g3").Value
dosya_adi = birim & "_" & malzeme & "_" & tarih
ChDir "F:\Kemal"
ActiveWorkbook.SaveAs Filename:="F:\Kemal\" & dosya_adi & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
MsgBox "Dosya F:\Kemal\ klasörüne " & dosya_adi & " adıyla farklı bir dosya olarak kaydedildi."

End Sub

 

[Ömer]

Merhaba

Deneyiniz.

Sub farkli_Kaydet()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
Dim birim, tarih, dosya_adi As String
On Error Resume Next
birim = s1.Range("b1").Value
malzeme = s1.Range("e6").Value
tarih = s1.Range("g3").Value
dosya_adi = birim & "_" & malzeme & "_" & tarih

'ilave
Dim kls, yol As String
Set kls = CreateObject("Scripting.FileSystemObject")
yol = "F:\Kemal"

k = kls.FolderExists(yol)
If k = False Then
    kls.CreateFolder yol
End If
''''''''

ChDir "F:\Kemal"
ActiveWorkbook.SaveAs Filename:="F:\Kemal\" & dosya_adi & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
MsgBox "Dosya F:\Kemal\ klasörüne " & dosya_adi & " adıyla farklı bir dosya olarak kaydedildi."

End Sub

 

[muratboz06]

Sub farkli_Kaydet() satırından sonra aşağıdaki kodları ekleyiniz.

Dim strDir As String
    strDir = "F:\Kemal"
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    End If

 

[sbayyigit]

teşekkürler arkadaşlar

 

[sbayyigit]

Ömer hocam verdiğiniz kod kodu ile çalıştırdım(Bu arada muratboz06 ile de denedim sorun çıkmadı) fakat burada şöyle bir sorun çıkıyor. programı yüklediğim bilgisayarda F: sürücüsü yoksa sorun devam ediyor. böyle bir durumda
Eğer F: sürücüsü yoksa C: sürücüsüne klasör oluşturabilir mi?

 

[Ömer]

Deneyiniz.

Sub farkli_Kaydet()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
Dim birim, tarih, dosya_adi As String
On Error Resume Next
birim = s1.Range("b1").Value
malzeme = s1.Range("e6").Value
tarih = s1.Range("g3").Value
dosya_adi = birim & "_" & malzeme & "_" & tarih

'ilave
Dim kls, yol As String
Set kls = CreateObject("Scripting.FileSystemObject")

If Dir("F:\", vbDirectory) <> "" Then
    yol = "F:\Kemal"
Else
    yol = "C:\Kemal"
End If

k = kls.FolderExists(yol)
If k = False Then
    kls.CreateFolder yol
End If
''''''''

ChDir yol
ActiveWorkbook.SaveAs Filename:="F:\Kemal\" & dosya_adi & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
MsgBox "Dosya F:\Kemal\ klasörüne " & dosya_adi & " adıyla farklı bir dosya olarak kaydedildi."

End Sub

 

[sbayyigit]

Çok teşekkürler ömer hocam