Public Sub CheckFolder()
Dim myFileSystem As New Scripting.FileSystemObject
Dim myFolder As Scripting.Folder
Dim DestFolder As String
Dim wb As Workbook
Dim ans As Integer
Dim PathAndFile As String
Set wb = ActiveWorkbook
DestFolder = "C:My Document"
PathAndFile = DestFolder & "" & wb.Name
If Not myFileSystem.FolderExists(DestFolder) Then
ans = MsgBox("Folder does not exist. Create it and save file?", vbYesNo + vbInformation)
If ans = vbYes Then
myFileSystem.CreateFolder (DestFolder)
wb.SaveAs PathAndFile
End If
End If
End Sub