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:

Code:

---

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 :giggle

/Roger

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

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... :argue

/Roger

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.

Hi Richie

As i said, all suggestions are more than welcome :006:

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 :roll:

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

Code:

---

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

---

I tried using:

Code:

---

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. :dunno

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?

Code:

---

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 :bore

For creating the local copies without using the selects you could use something like:

Code:

---

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.

:)

Hi Mark

Thanks for your reply!

This works fine except from an error in line:

Code:

---

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

---

With this in my code it works fine:

Code:

---

Dim strFileName As String, ws As Worksheet
strFileName = ThisWorkbook.FullName
For Each ws In ThisWorkbook.Worksheets
SaveSheet ws.Name
Next
ThisWorkbook.SaveAs strFileName, xlWorkbookNormal

---

Quote:

---

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

Quote:

---

This works fine except from an error in line:

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

---

What's the error?

:)

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

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.

:)

Hi All :hi:


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 :type

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

/Roger