Save in two places

menteith · #1 01-20-2016, 08:42 AM

Hi all,

I am very new to VBA so I would like to get some help with a macro I have created (some parts of it were found in the Internet). The macro should save make a backup (in a specified path) of a file that is currently being saved, a procedure that is often discussed since Word lacks of it. I will talk over what I think the macro does and should do.

1. FileSave procedure is intercepted.
2. The macro checks if an active document is saved. If it is, no extra action is required and the macro closes.
3. If an active document in not saved, the usual "Save As" dialogue appears. If the user chooses to not save the file then the macro closes.
4. If document is not saved, the macros saves it.
5. The macro looks for a backup folder. If it is not found, the macro creates it and shows a message box.
6. Then the macro checks if the source folder is the same as the backup folder. If they are the same, the macro shows a message and closes.
7. The active (current) document is copied to the backup folder. If it fails, a message box is displayed.

I tested this macro and it seems to work. However, there is a huge imperfection. When document is modified and the user chooses to close it, a dialogue appears asking if the document should be saved. If the user chooses to do so, the document is saved, but a backup copy is not created - and I would like to create a backup in this situation.

Could you check the macro against errors and suggest how to implement the above-mentioned feature? I am newbie so I am pretty sure that the macro is, to say the least, imperfect and it could be rewritten. I did my best to make it as elegant (e.g. I tried to avoid the GoTo procedure) and short as I could.

Please find the macro below.

Code:

Sub FileSave() 
    Dim source As String 
    Dim DocName As String 
    Dim objF As Object 
    Dim retVal As Long 
     
    backup = "C:\Users\" & Environ("UserName") & "\Documents\BackupWord\" 
     
    With ActiveDocument 
         
        If .Saved Then Exit Sub 
        If .Path = "" Then 
            If Application.Dialogs(wdDialogFileSaveAs).Show <> -1 Then Exit Sub 
        End If 
         'GoTo continue
         
        If Not .Saved Then 
            ActiveDocument.Save 
        End If 
         'continue:
        If Dir(backup, vbDirectory) = "" Then 
            MkDir backup 
            MsgBox "Backup folder has been created.", vbInformation 
        End If 
         
        source = .Path & "\" 
        DocName = .Name 
        If source = backup Then 
            MsgBox "WARNING! Backup folder is the same as the source folder." 
            Exit Sub 
        End If 
         
        Set objF = CreateObject("Scripting.FileSystemObject") 
        retVal = -1 
        On Error Resume Next 
        retVal = objF.CopyFile(source & DocName, _ 
        backup & DocName, True) 
        On Error GoTo 0 
        Set objF = Nothing 
        If retVal <> 0 Then 
            MsgBox "Backup has not been copied to folder " & backup 
        End If 
    End With 
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
in 2013, cannot format 4 dec places in Word Document	Abacus1234	Mail Merge	3	10-23-2013 03:57 PM
Word Documents appear in two places	Drjh68	Word	1	08-25-2013 03:19 PM
Forced extra decimal places	Metamag	Excel	11	08-18-2012 03:10 AM
Mail Merge, Number to 2 Decimal Places	Vampy99	Mail Merge	7	09-25-2011 05:41 AM
My Places	lukewarmbeer	Office	0	07-13-2010 02:33 PM