Consulting

Results 1 to 11 of 11

Thread: Solved: Create txt Backup

  1. #1
    VBAX Regular
    Joined
    May 2004
    Location
    Sweden
    Posts
    21
    Location

    Solved: Create txt Backup

    Hi All!

    I'm trying to help my wife to create a simple Workbook Backup. This backup must save all data to the Floppy Drive. Her Workbook contains 4 different sheets: Data, Article, Contacts & Information. Sheets Data is between 2.5 to 3 Mb and because of this i save all sheets separetly as txt. In txt format sheets Data changes between 1 to 1.2 Mb (Floppy Disc 1), the other 3 can be saved to the same disc (Floppy Disc 2).

    This is what i'm trying to do... :

    Create a hardrive temp folder C:\New Backup.

    Copy each sheet separetly to a new book and save in C:\New Backup as txt.

    Ask for disc 1.

    Copy sheets Data.txt from C:\New Backup to Disc 1.

    Ask for Disc 2.

    Copy sheets Article, Contacts & Information from C:\New Backup to Disc 2.

    Delete all files in C:\New Backup.

    Delete folder C:\New Backup.

    Everything works as i want it to, but just to be on the safe side, since i'm not very good on VBA, i thought i might ask some experts to have a look at it.

    I know it's quit much code, but any comment or suggestion will be highly appreciated.

    Here's what i come up with so far:
    [VBA]Sub Create_Backup()
    Dim fsoObj As Scripting.FileSystemObject, Fs As Object
    Dim strPath As String, strFileMask As String, f As String, stKallFil As String
    Set fsoObj = New Scripting.FileSystemObject

    Set Fs = CreateObject("Scripting.FileSystemObject")
    If MsgBox(strExcelApp & "Do you want to create a Backup?", vbYesNo + vbQuestion) = vbNo Then

    Exit Sub

    End If

    Application.DisplayAlerts = False

    Application.EnableEvents = False

    Application.ScreenUpdating = False


    'Check Drive C And Create Temp Folder New Backup

    With fsoObj

    If .Drives("C:").IsReady = True Then

    If .FolderExists("C:\New Backup\") Then

    MsgBox "Folder C:\New Backup allready exists!", vbInformation

    Else

    .CreateFolder ("C:\New Backup")

    MsgBox "Folder C:\New Backup was successfully created!", vbInformation
    End If

    End If

    End With


    'Copy Sheets Data And Save As Data.txt To C:\New Backup

    With fsoObj

    If .Drives("C:").IsReady = True Then

    Sheets("Data").Select

    Sheets("Data").Copy

    ActiveWorkbook.SaveAs Filename:="C:\New Backup\Data.txt", FileFormat:=xlText, CreateBackUp:=False

    ActiveWindow.Close

    MsgBox "Sheets Data was successfully copied to C:\New Backup\Data.txt!", vbInformation

    End If

    End With


    'Copy Sheets Article And Save As Article.txt To C:\New Backup

    With fsoObj

    If .Drives("C:").IsReady = True Then

    Sheets("Article").Select

    Sheets("Article").Copy

    ActiveWorkbook.SaveAs Filename:="C:\New Backup\Article.txt", FileFormat:=xlText, CreateBackUp:=False

    ActiveWindow.Close

    MsgBox "Sheets Article was successfully copied to C:\New Backup\Article.txt!", vbInformation

    End If

    End With

    'Copy Sheets Contacts And Save As Contacts.txt To C:\New Backup

    With fsoObj

    If .Drives("C:").IsReady = True Then

    Sheets("Contacts").Select

    Sheets("Contacts").Copy

    ActiveWorkbook.SaveAs Filename:="C:\New Backup\Contacts.txt", FileFormat:=xlText, CreateBackUp:=False

    ActiveWindow.Close

    MsgBox "Sheets Contacts was successfully copied to C:\New Backup\Contacts.txt!", vbInformation

    End If

    End With


    'Copy Sheets Information And Save As Information.txt In C:\New Backup

    With fsoObj

    If .Drives("C:").IsReady = True Then

    Sheets("Information").Select

    Sheets("Information").Copy

    ActiveWorkbook.SaveAs Filename:="C:\New Backup\Information.txt", FileFormat:=xlText, CreateBackUp:=False

    ActiveWindow.Close

    MsgBox "Sheets Information was successfully copied to C:\New Backup\Information.txt!", vbInformation

    End If

    End With

    Sheets("Start").Activate

    Range("B2").Activate

    Application.ScreenUpdating = True

    'Create Backup Disc 1
    MsgBox "Please insert Backup Disc One! Click OK to continue!", vbExclamation


    'Check Drive A:\
    Disc1:

    With fsoObj

    If .Drives("A:").IsReady = False Then

    If MsgBox(strExcelApp & "No disc was found! Please insert Backup Disc One! Continue?", vbYesNo + vbQuestion) = vbNo Then

    MsgBox "Backup was not completed! Please create a new Backup as soon as possible!", vbCritical

    GoTo Finish

    End If

    GoTo Disc1

    End If

    End With


    'Clear Backup Disc One
    On Error Resume Next
    strPath = "A:\"

    strFileMask = "*.*"

    With fsoObj

    If Dir(strPath & strFileMask) <> "" Then

    Kill strPath & strFileMask

    End If
    Fs.DeleteFolder "A:\*.*", True

    End With

    MsgBox "Backup Disc One was successfully cleared!", vbInformation


    'Copy Data.txt From C:\ To A:\
    stKallFil = "C:\New Backup\Data.txt"

    With fsoObj

    .CopyFile Source:=stKallFil, Destination:="a:\"

    MsgBox "Sheets Data was successfully copied from C:\New Backup\Data.txt to A:\Data.txt!", vbInformation

    End With

    MsgBox "Backup Disc One was successfully created!", vbInformation


    'Backup Disc 2
    MsgBox "Please insert Backup Disc Two! Click OK to continue!", vbExclamation

    'Check Drive A:\
    Disc2:

    With fsoObj

    If .Drives("A:").IsReady = False Then

    If MsgBox(strExcelApp & "No disc was found! Please insert Backup Disc Two! Continue?", vbYesNo + vbQuestion) = vbNo Then

    MsgBox "Backup was not completed! Please create a new Backup as soon as possible!", vbCritical

    GoTo Finish

    End If

    GoTo Disc2

    End If

    End With


    'Clear Backup Disc Two
    On Error Resume Next
    strPath = "A:\"

    strFileMask = "*.*"

    With fsoObj

    If Dir(strPath & strFileMask) <> "" Then

    Kill strPath & strFileMask

    End If
    Fs.DeleteFolder "A:\*.*", True

    End With

    MsgBox "Backup Disc Two was successfully cleared!", vbInformation


    'Copy Article.txt From C:\ To A:\
    stKallFil = "C:\New Backup\Article.txt"

    With fsoObj

    .CopyFile Source:=stKallFil, Destination:="a:\"

    MsgBox "Sheets Article was successfully copied from C:\New Backup\Article.txt to A:\Article.txt!", vbInformation

    End With

    'Copy Contacts.txt From C:\ To A:\
    stKallFil = "C:\New Backup\Contacts.txt"

    With fsoObj

    .CopyFile Source:=stKallFil, Destination:="a:\"

    MsgBox "Sheets Contacts was successfully copied from C:\New Backup\Contacts.txt to A:\Contacts.txt!", vbInformation

    End With

    'Copy Information.txt From C:\ To A:\
    stKallFil = "C:\New Backup\Information.txt"

    With fsoObj

    .CopyFile Source:=stKallFil, Destination:="a:\"

    MsgBox "Sheets Information was successfully copied from C:\New Backup\Information.txt to A:\Information.txt!", vbInformation

    End With

    MsgBox "Backup Disc Two was successfully created!", vbInformation

    MsgBox "Backup completed!", vbInformation


    'Delete Temporary Folder C:\New Backup And Files
    Finish:

    On Error Resume Next

    With fsoObj

    Kill "C:\New Backup\*.*"

    MsgBox "All files in folder C:\New Backup was successfully deleted!", vbInformation
    RmDir "C:\New Backup"

    MsgBox "Folder C:\New Backup was successfully deleted!", vbInformation

    End With

    Set fsoObj = Nothing

    Application.DisplayAlerts = True

    Application.EnableEvents = True
    End Sub[/VBA]

    Please, be nice

    /Roger
    Last edited by Jacob Hilderbrand; 06-09-2004 at 05:54 AM. Reason: Question has been answered

  2. #2
    VBAX Tutor jamescol's Avatar
    Joined
    May 2004
    Location
    Charlotte, NC
    Posts
    251
    Location
    Roger,
    Can you tell us what versions of Excel and Windows are you using? And also what, if any, errors/problems you are seeing?


    Thanks,
    James
    "All that's necessary for evil to triumph is for good men to do nothing."

  3. #3
    VBAX Regular
    Joined
    May 2004
    Location
    Sweden
    Posts
    21
    Location
    Hi James

    Thanks for your reply!

    I'm using Office 2000 at home and i belive that my wife are running Office 2003 at work.

    As i said in my first post, it all works ok on my machine (Office 2000).

    I just want to make shure that nothing can go wrong when my wife is using the backup, because if it does i probably have the pleasure of having an extremely cold summer...

    /Roger

  4. #4
    VBAX Contributor Richie(UK)'s Avatar
    Joined
    May 2004
    Location
    UK
    Posts
    188
    Location
    Hi Roger,

    There is a lot of repetition in your code. Try to create separate functions/subs for code that is repeated, or use loops to repeat the common parts. This will help you to create 'modular' code that is easier to write and easier to debug.

    If I get time I'll put something together later to illustrate.
    Last edited by Richie(UK); 06-07-2004 at 02:17 PM.

  5. #5
    VBAX Regular
    Joined
    May 2004
    Location
    Sweden
    Posts
    21
    Location
    Hi Richie

    As i said, all suggestions are more than welcome

    The code i posted was sort of a "step by step" code with lot's of Msgboxes etc to keep track of what was happening.

    I posted it just to illustrate what i was trying to do, i'm not always shure myself

    In the last version their are still some repeats. For ex:

    Sheets("Data").Select

    Sheets("Data").Copy

    ActiveWorkbook.SaveAs Filename:="C:\New Backup\Data.txt", FileFormat:=xlText, CreateBackUp:=False

    ActiveWindow.Close

    I tried using:

    Sheets("Data").SaveAs Filename:="C:\New Backup\Data.txt", FileFormat:=xlText, CreateBackUp:=False

    But when i tried this it renamed the workbook to the last sheet, Information.txt. Another repeat is the Clear Floppy. I haven't managed to loop through this twice, so i ended up doing it once for each Disc.

    The first file i copy to Disc 1 feels ok, but with the other 3 i copy one at the time and i suppose that their is a way to copy all 3 together?

    Anyway, here is the "short" version. If you feel that your having to much sparetime, maybe you would be kind enough to make some comments?

    [VBA]
    Sub Create_Backup()
    Dim fsoObj As Scripting.FileSystemObject, Fs As Object
    Dim strPath As String, strFileMask As String, f As String, stKallFil As String
    Set fsoObj = New Scripting.FileSystemObject

    Set Fs = CreateObject("Scripting.FileSystemObject")
    If MsgBox(strExcelApp & "Do you want to create a Backup?", vbYesNo + vbQuestion) = vbNo Then

    Exit Sub

    End If

    Application.DisplayAlerts = False

    Application.EnableEvents = False

    With fsoObj

    If .FolderExists("C:\New Backup\") Then

    Else

    .CreateFolder ("C:\New Backup")
    End If

    Application.ScreenUpdating = False

    Sheets("Data").Select

    Sheets("Data").Copy

    ActiveWorkbook.SaveAs Filename:="C:\New Backup\Data.txt", FileFormat:=xlText, CreateBackUp:=False

    ActiveWindow.Close

    Sheets("Article").Select

    Sheets("Article").Copy

    ActiveWorkbook.SaveAs Filename:="C:\New Backup\Article.txt", FileFormat:=xlText, CreateBackUp:=False

    ActiveWindow.Close

    Sheets("Contacts").Select

    Sheets("Contacts").Copy

    ActiveWorkbook.SaveAs Filename:="C:\New Backup\Contacts.txt", FileFormat:=xlText, CreateBackUp:=False

    ActiveWindow.Close

    Sheets("Information").Select

    Sheets("Information").Copy

    ActiveWorkbook.SaveAs Filename:="C:\New Backup\Information.txt", FileFormat:=xlText, CreateBackUp:=False

    ActiveWindow.Close

    Sheets("Start").Activate

    Range("B2").Activate

    Application.ScreenUpdating = True
    MsgBox "Please insert Backup Disc One! Click OK to continue!", vbExclamation
    Disc1:

    If .Drives("A:").IsReady = False Then

    If MsgBox(strExcelApp & "No disc was found! Please insert Backup Disc One! Continue?", vbYesNo + vbQuestion) = vbNo Then

    MsgBox "Backup was not completed! Please create a new Backup as soon as possible!", vbCritical

    GoTo Finish

    End If

    GoTo Disc1

    End If

    On Error Resume Next
    strPath = "A:\"

    strFileMask = "*.*"

    If Dir(strPath & strFileMask) <> "" Then

    Kill strPath & strFileMask

    End If
    Fs.DeleteFolder "A:\*.*", True
    stKallFil = "C:\New Backup\Data.txt"

    .CopyFile Source:=stKallFil, Destination:="a:\"

    MsgBox "Backup Disc One was successfully created!", vbInformation
    MsgBox "Please insert Backup Disc Two! Click OK to continue!", vbExclamation
    Disc2:

    If .Drives("A:").IsReady = False Then

    If MsgBox(strExcelApp & "No disc was found! Please insert Backup Disc Two! Continue?", vbYesNo + vbQuestion) = vbNo Then

    MsgBox "Backup was not completed! Please create a new Backup as soon as possible!", vbCritical

    GoTo Finish

    End If

    GoTo Disc2

    End If
    On Error Resume Next
    strPath = "A:\"

    strFileMask = "*.*"

    If Dir(strPath & strFileMask) <> "" Then

    Kill strPath & strFileMask

    End If
    Fs.DeleteFolder "A:\*.*", True
    stKallFil = "C:\New Backup\Article.txt"

    .CopyFile Source:=stKallFil, Destination:="a:\"
    stKallFil = "C:\New Backup\Contacts.txt"

    .CopyFile Source:=stKallFil, Destination:="a:\"
    stKallFil = "C:\New Backup\Information.txt"

    .CopyFile Source:=stKallFil, Destination:="a:\"
    Application.DisplayAlerts = True

    Application.EnableEvents = True

    MsgBox "Backup Disc Two was successfully created!", vbInformation

    MsgBox "Backup completed!", vbInformation
    Finish:

    On Error Resume Next

    Kill "C:\New Backup\*.*"
    RmDir "C:\New Backup"

    End With

    Set fsoObj = Nothing
    End Sub
    [/VBA]

    /Roger

  6. #6
    BoardCoder
    Licensed Coder
    VBAX Expert mark007's Avatar
    Joined
    May 2004
    Location
    Leeds, UK
    Posts
    619
    Location
    For creating the local copies without using the selects you could use something like:

    [vba]
    Sub CreateLocalDiskBackup()
    Dim strFileName As String
    strFileName = ThisWorkbook.FullName
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
    SaveSheet ws.Name
    Next
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs strFileName, xlWorkbookNormal
    Application.DisplayAlerts = True
    End Sub


    Sub SaveSheet(strName As String)
    ThisWorkbook.Sheets(strName).SaveAs "C:\New Backup\" & strName & ".txt", xlText
    End Sub
    [/vba]

    Also, I think you should change the code you have so far to ask before deleting everything off the floppy. Otherwise valuable data could be lost.

    "Computers are useless. They can only give you answers." - Pablo Picasso
    Mark Rowlinson FIA | The Code Net | Professional Office Developers Association

  7. #7
    VBAX Regular
    Joined
    May 2004
    Location
    Sweden
    Posts
    21
    Location
    Hi Mark

    Thanks for your reply!

    This works fine except from an error in line:

    ThisWorkbook.Sheets(strName).SaveAs "C:\New Backup\" & strName & ".txt", xlText

    With this in my code it works fine:
    [VBA] Dim strFileName As String, ws As Worksheet

    strFileName = ThisWorkbook.FullName

    For Each ws In ThisWorkbook.Worksheets

    SaveSheet ws.Name

    Next

    ThisWorkbook.SaveAs strFileName, xlWorkbookNormal[/VBA]
    Also, I think you should change the code you have so far to ask before deleting everything off the floppy. Otherwise valuable data could be lost.
    You are absolutely right!

    In my original code (in swedish, i didn't have the energy to translate all msgboxex...) a vbYes/No Msgbox occur before the "Clear Floppy". I do this to prevent any errors with disc space (backup takes about 1.3 mb in each disc) when i run the code in "the right" workbook.

    /Roger

  8. #8
    BoardCoder
    Licensed Coder VBAX Expert mark007's Avatar
    Joined
    May 2004
    Location
    Leeds, UK
    Posts
    619
    Location
    This works fine except from an error in line:

    ThisWorkbook.Sheets(strName).SaveAs "C:\New Backup\" & strName & ".txt", xlText
    What's the error?

    "Computers are useless. They can only give you answers." - Pablo Picasso
    Mark Rowlinson FIA | The Code Net | Professional Office Developers Association

  9. #9
    VBAX Regular
    Joined
    May 2004
    Location
    Sweden
    Posts
    21
    Location
    Hi Mark


    My misstake...

    Nothings wrong with your code, it works fine!

    Any suggestions about the rest of the code?

    As i said, it worked to begin with, but i'm sure their must be more things i can do differently?
    /Roger

  10. #10
    BoardCoder
    Licensed Coder VBAX Expert mark007's Avatar
    Joined
    May 2004
    Location
    Leeds, UK
    Posts
    619
    Location
    There's nothing in the rest of it that stands out as being problematic other than not asking about deleting the files. There are a few extra things that could be wrapped into subs I guess to avoid repetition but as logn as it works this isn't important really.

    "Computers are useless. They can only give you answers." - Pablo Picasso
    Mark Rowlinson FIA | The Code Net | Professional Office Developers Association

  11. #11
    VBAX Regular
    Joined
    May 2004
    Location
    Sweden
    Posts
    21
    Location
    Hi All


    With that last post from Mark i think the most have been said and done?

    Anyway, i posted this to see what parts i could have done differently, and i learn something new every day

    Thanks Richie, James and Mark for taking up your time reviewing this, it's highly appreciated

    /Roger

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •