Consulting

Results 1 to 11 of 11

Thread: Create txt Backup

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

    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:

    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
    Please, be nice

    /Roger
    Last edited by Aussiebear; 04-30-2023 at 12:39 AM.

  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?


    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

    /Roger

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


    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

    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

  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:

    Dim strFileName As String, ws As Worksheet
    strFileName = ThisWorkbook.FullName
    For Each ws In ThisWorkbook.Worksheets
    SaveSheet ws.Name
    Next
    ThisWorkbook.SaveAs strFileName, xlWorkbookNormal
    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
    622
    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

  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
    622
    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

  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
  •