foutmelding aanmaken directory

[vrouw]

Ik gebruik onderstaande code om een bestand in een map op te slaan als het bestand word gesloten.
Echter krijg ik een foutmelding als de map al bestaat.
Hoe kan ik dat oplossen?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
MkDir "c:\Temp\" & Dirname
    MyFileName = "C:\Temp\posten & voorraadbestand.xlsx"
    If Len(Dir(MyFileName)) Then
        SetAttr MyFileName, vbNormal
        Kill MyFileName
    End If
    Application.DisplayAlerts = False
     ActiveWorkbook.SaveAs MyFileName, FileFormat:=51
     SetAttr MyFileName, vbReadOnly
End Sub

 

[HSV]

Beter?

 If Dir("c:\Temp\" & Dirname) = "" Then MkDir "c:\Temp\" & Dirname

 

[edmoor]

Maak er even dit van:

 If Dir("c:\Temp\" & Dirname, VbDirectory) = "" Then MkDir "c:\Temp\" & Dirname

 

[jkpieterse]

Gebruik deze functie:

Function FolderExists(strPath As String) As Boolean
    On Error Resume Next
    FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
End Function

De Dir functie samen met vbDirectory geeft namelijk een "false positive" als er in de hoger liggende map een bestand staat met de naam van de laatste subfolder.
Dus als er in map c:\folder GEEN subfolder is maar wel een bestand met de naam subfolder, dan geeft Dir wel een resultaat terwijl de subfolder niet bestaat.

 

[HSV]

Misschien een alternatief:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim DirName As String, MyFileName As String
DirName = "Blabla"
Application.DisplayAlerts = False
CreateObject("shell.application").Namespace("C:\").NewFolder "Temp\" & DirName & "\"
    MyFileName = "C:\Temp\" & DirName & "\posten & voorraadbestand.xlsx"
    If Len(Dir(MyFileName)) Then
        SetAttr MyFileName, vbNormal
        Kill MyFileName
    End If
    ThisWorkbook.SaveAs MyFileName, 51
     SetAttr MyFileName, vbReadOnly
   Application.DisplayAlerts = True
End Sub