[Resolvido]backup nao da certo

boa noite estou utilizando este modolo para backup mais na da certo, estou utilizando o access2003.

Public Sub ZipaBanco()
'JPaulo ® Maximo Access
Dim strDate As String, DefPath As String
Dim oApp As Object
Dim FName, FileNameZip
Dim strPrefix As String
On Error Resume Next
DefPath = Application.CurrentProject.Path & "C:Backup" 'Local e pasta onde está o banco de backup
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

strDate = Format(Now, "dd-mmmm-yyyy_hh-mm")
FileNameZip = DefPath & "Backup_" & strDate & ".zip"
strPrefix = "Sicoest" 'Nome do banco
FName = Application.CurrentProject.Path & "\" & strPrefix & ".mdb"
On Error Resume Next
CriaNovoZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(FileNameZip).CopyHere FName
Set oApp = Nothing
Exit Sub
End Sub

Public Sub CriaNovoZip(sPath)
'Criado pelo meu amigo e colega Raw do Canadá
'Adaptado por JPaulo ® Maximo Access
'Zipa banco no backup
Dim ofso, arrHex, sBin, i, Zip
On Error Resume Next
Set ofso = CreateObject("Scripting.FileSystemObject")
arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(arrHex)
sBin = sBin & Chr(arrHex(i))
Next
On Error Resume Next
With ofso.CreateTextFile(sPath, True)
.Write sBin
.Close
End With
Exit Sub
End Sub

boa noite, consegui resolver.