Experts Exchange connects you with the people and services you need so you can get back to work.
Improve company productivity with a Business Account.Sign Up
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim bCopy As Boolean
Const SaveAsPath = "C:\Users\pike\Desktop\backup\"
Cancel = True
On Error Resume Next
bCopy = Evaluate(ThisWorkbook.Names("Copy").RefersTo)
If bCopy Then
ThisWorkbook.Close True ''??? True will ensure the workbook is saved before closing
Select Case MsgBox("Would you like to create a backup copy?", vbYesNo _
Or vbQuestion Or vbDefaultButton1, "Create Copy")
ActiveWorkbook.SaveAs SaveAsPath & ThisWorkbook.Name & Format(Date, _
"ddmmyyyy") & ".xlsm", FileFormat:=52
''/// set the flag is the Name
ThisWorkbook.Names.Add Name:="Copy", RefersTo:=1, Visible:=True
On Error GoTo 0
Open in new window
saves down a file to a folder with the corresponding month and year
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Dim strFolderPath As String
strFolderPath = "C:\2016\10-Oct 2016\"
If Dir(strFolderPath, vbDirectory) <> vbNullString Then
Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.
One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.
strDir = "S:\2016\10-OCT-2016\"
If Dir(strDir, vbDirectory) = "" Then MkDir strDir
Public Sub TestFolderExists()
Dim sFullPath As String
sFullPath = "S:" & Year(Date) & Application.PathSeparator & Format(Date, "dd-mmm yyyy")
If Not Dir(sFullPath, vbDirectory) = vbNullString Then
MsgBox sFullPath & " exists!"
Else: MkDir (sFullPath)
Dim fso As Scripting.FileSystemObject
Dim ArrPath As Variant
Dim n As Integer
Dim sFullPath As String
Set fso = New Scripting.FileSystemObject
sFullPath = CurrentProject.Path & "\" & Year(Date) & "\" & Format(Date, "dd-mmm yyyy")
ArrPath = Split(sFullPath, "\")
sFullPath = ArrPath(0)
For n = 1 To UBound(ArrPath)
sFullPath = sFullPath & "\" & ArrPath(n)
If Not fso.FolderExists(sFullPath) Then
Set fso = Nothing
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
Please enter a first name
Please enter a last name
Must be at least 4 characters long.
Join and Comment
From novice to tech pro — start learning today.
Premium members can enroll in this course at no extra cost.