Backup Files with VBA

Files Backup (Macro)
Using Excel the following 2 subs work together to copy files from one location to another.

Sub backup_files()

Dim cnt As Double
Dim fromjoin As String
Dim tojoin As String
Dim maxrow As Double
Dim yes_errors As Variant

Dim xlobj As Object
Set xlobj = CreateObject(“Scripting.FileSystemObject”)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Application.StatusBar = “Running…this line will disappear when complete.”

cnt = 3
maxrow = Range(“A” & ActiveSheet.Rows.Count).End(xlUp).Row

    Do While cnt < maxrow + 1
       
        ‘populate variables
        filename = Cells(cnt, 1).Value
        frompath = Cells(cnt, 2).Value
        topath = Cells(cnt, 3).Value
       
        ‘if blank from path
        If frompath = “” Then
            frompath = ActiveWorkbook.Path
        End If
       
        ‘if blank to path
        If topath = “” Then
            MkDir ActiveWorkbook.Path & “\” & “@Archive”
            topath = ActiveWorkbook.Path & “\” & “@Archive”
        End If
       
        ‘path must end in a backslash
        If Right(frompath, 1) <> “\” Then
            frompath = frompath & “\”
        End If
        If Right(topath, 1) <> “\” Then
            topath = topath & “\”
        End If
       
        fromjoin = frompath & filename
        tojoin = topath & filename
       
        ‘color the cell if the file does not exist at the provided from path
        If Dir(fromjoin) = “” Then
            Cells(cnt, 1).Interior.Color = RGB(255, 0, 0)
            yes_errors = True
            GoTo skipfile:
        End If
       
        ‘copy the file
        ‘FileCopy fromjoin, tojoin (this line dies if file is open)
        xlobj.CopyFile fromjoin, tojoin, True

        Cells(cnt, 1).Interior.Color = xlColorIndexNone
   
skipfile:

    cnt = cnt + 1
    Loop
   
    ‘alert user if there were errors
    If yes_errors = True Then
        Application.StatusBar = “The File Name at the Copy From Path could not be found.” & vbCr & vbCr & ”            It has been colored red for you to correct.”
        GoTo errornote:
    End If

Application.StatusBar = False
errornote:

ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Sub copythatfile()
   
    Dim xlobj As Object
   
    Set xlobj = CreateObject(“Scripting.FileSystemObject”)
    ‘object.copyfile,source,destination,file overright(True is default)
    xlobj.CopyFile “c:\bob\bob3.xls”, “c:\bob\copybob3.xls”, True
   
    Set xlobj = Nothing

End Sub

Advertisements

One response

9 08 2011
File Backup with VBA « VBA Ninja

[…] Check it out! […]

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s




%d bloggers like this: