Private Sub cmdArchive_Click()
On Error GoTo Err_cmdArchive_Click
Const OrigFolder As String = "MyFolder"
Const Archive As String = "Archive/"
Dim fso As FileSystemObject
Dim fsoArchive As Folder
Dim fsoFolder As Folder
Dim strSource As String
Dim strDest As String
Set fso = New FileSystemObject
Set fsoArchive = fso.GetFolder(QuoteStore & Archive)
strSource = QuoteStore & OrigFolder
strDest = QuoteStore & Archive
If MsgBox("Are you sure you wish to archive the folder '" & OrigFolder & "'?", vbQuestion + vbYesNo) = vbYes Then
With fso
.MoveFolder strSource, strDest
For Each fsoFolder In fsoArchive.SubFolders
If fsoFolder.Name = OrigFolder Then
fsoFolder.Name = fsoFolder.Name & "-" & Format(Now, "yyyymmddhhnnss")
End If
Next
End With
End If
Exit_cmdArchive_Click:
strSource = vbNullString
strDest = vbNullString
Set fso = Nothing
Set fsoFolder = Nothing
Set fsoArchive = Nothing
Exit Sub
Err_cmdArchive_Click:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume Exit_cmdArchive_Click
End Sub