This worked for AK2. Gave a choice of backing up to floppy or CD.
There are 2 tables, 1 called "Paths" designating the name of the file to be
backed up (Data Mdb), the zip file wich is irrelevant for CD backup, and
whether to back up on Floppy or CD.
The other table "Backups" recorded when the backup was made etc
HTH
Phil
Function Backup(DataPath As String, ZipPath As String, BackupType As Byte)
Dim MyDb As Database
Dim PathSet As Recordset, BackupSet As Recordset
Dim ZipProgPath As String ' path for WZZip
(Winzip)
Dim CDBackupPath As String, BackupFolder As String ' Folder for the CD
backup
Dim fs As Object
Dim File
Dim Msg As String
On Error GoTo BackupData_Err
Set MyDb = CurrentDb
Set PathSet = MyDb.OpenRecord set("Paths")
If IsNull(PathSet! ZipProgPath) Then
MsgBox "There is no program designated for the Floppy Zip program",
vbCritical, "Insufficie nt Detail"
Exit Function
End If
ZipProgPath = PathSet!ZipProg Path ' Name of Zip
Program
CDBackupPath = PathSet!CDBacku pPath ' Folder for the CD
backup
PathSet.Close
Set PathSet = Nothing
If BackUpMedia = 1 Then
GoTo FloppyBackup
End If
If BackUpMedia = 2 Then
GoTo CDBackup
End If
FloppyBackup:
Set fs = CreateObject("S cripting.FileSy stemObject")
If Dir(ZipPath) <> "" Then ' Make sure that the zipped data
file exists
fs.deletefile ZipPath
End If
'run Winzip approzimately 60% compression
ShellWait (ZipProgPath & " " & Chr$(34) & ZipPath & Chr$(34) & " " &
Chr$(34) & DataPath & Chr$(34)), vbNormalFocus
CheckDirectory:
If Dir(ZipPath) <> "" Then ' Make sure that the zipdata file
exists
fs.Copyfile ZipPath, "A:/", True ' Copy Data to AMM Services
Data.Bak
GoTo UpdateBackupTab le
Else
If MsgBox("Can't find the Zipped " & DataPath & " File", vbCritical
+ vbRetryCancel) = vbRetry Then
GoTo CheckDirectory
Else
Exit Function
End If
End If
CDBackup:
Set fs = CreateObject("S cripting.FileSy stemObject")
If CDBackupPath = "" Then
MsgBox "There is no path set for the CD backup", vbCritical,
"Insufficie nt Detail"
Exit Function
End If
If Dir(DataPath) <> "" Then ' Make sure that the
data file exists
If Dir(CDBackupPat h) = "" Then ' CD File not found
Msg = "Can't find the " & CDBackupPath & " File on the CD" &
Chr$(13)
Msg = Msg & " Do you want to create this file yourself?"
If MsgBox(Msg, vbQuestion + vbYesNo, "Missing CD File") = vbNo
Then
Exit Function
Else
BackupFolder = Left$(CDBackupP ath, (InStrRev(CDBac kupPath,
"\") - 1))
fs.createfolder (BackupFolder)
End If
End If
fs.Copyfile DataPath, CDBackupPath, True ' Copy Data to AMM
Services Data.Bak
GoTo UpdateBackupTab le
Else
MsgBox "Can't find the " & DataPath & " File", vbCritical
Exit Function
End If
UpdateBackupTab le:
Set BackupSet = MyDb.OpenRecord set("Backups") ' Open Backups table
' Table exists
Set File = fs.Getfile(CDBa ckupPath)
With BackupSet
.AddNew
!BackupDate = Now()
!BackupType = BackupType
!BackUpMedia = BackUpMedia ' 1 - Floppy,
2 - CD
!BackUpSize = File.Size
.Update
.Close
End With
MsgBox "Backup Completed Successfully", vbInformation, "Backup Data"
ReturnValue = SysCmd(acSysCmd ClearStatus)
Exit Function
BackupData_Err:
ReturnValue = SysCmd(acSysCmd ClearStatus)
If Err = 52 Then
If BackUpMedia = 2 Then
MsgBox "There is no CD in the Drive", vbCritical
End If
Exit Function
End If
If Err = 76 Then
If BackUpMedia = 1 Then
MsgBox "There is no Floppy Disk in the Drive", vbCritical
Else
MsgBox "The required directory is not on the CD", vbCritical
End If
Exit Function
End If
If Err = -2147024784 Then
If BackUpMedia = 1 Then
MsgBox "The Floppy Disk is full", vbCritical
Else
MsgBox "The CD is full", vbCritical
End If
Exit Function
End If
MsgBox Err.Description
End Function
"Bruce Dodds" <br********@com cast.net> wrote in message
news:htdGc.2862 2$Oq2.23740@att bi_s52...
One of my clients is going to move to CD or DVD as a medium to
backup/transfer data. Is it possible for an A2003 application to write
directly to a CD or DVD under Win XP, or will I need to set up an
external script?
TIA,
Bruce
