Link to home
Start Free TrialLog in
Avatar of Ronald Malk
Ronald MalkFlag for Australia

asked on

MS Access VBA Button Create new file for Backup only Tables

Hi every one,
I have this code below is working fine for backing up the file to a new file name
is it possible to make it only backing up only All tables to the new file name.

Function BackupSource()
    DoCmd.Hourglass True
    On Error GoTo Errorhandler
Dim strBu As String
   Dim buf As String
      Dim MD_Date As Variant
         Dim fs As Object
            Dim strSourceName As String
               Dim strSourceFile As String
                  Const conPATH_FILE_ACCESS_ERROR = 75

strSourceName = CurrentProject.Name
strSourceFile = CurrentProject.Path
buf = "C:\WinRef\"

   If GetAttr(buf) <> vbDirectory Then
   MkDir buf
   End If
   
MD_Date = "HCS" & Format(Date, "yyyy-mm-dd-") & Format(Time, "hh-mm-ss")
strSourceFile = CurrentProject.Path

strBu = "C:\WinRef\" & MD_Date & "\"
    MkDir (strBu)
         
            Set fs = CreateObject("Scripting.FileSystemObject")
               fs.CopyFile strSourceFile & "\" & strSourceName, strBu
            Set fs = Nothing

DoCmd.Hourglass False
    Exit Function
   
Errorhandler:
    DoCmd.Hourglass False
    DoCmd.OpenForm "MsgE_BkUpPc"
End Function
Avatar of als315
als315
Flag of Russian Federation image
You can use this sub:
Public Sub ExportTables(RESDB As String) 'RESDB - full path to backup DB
    On Error GoTo Errors
    Dim tdf As Object
    Dim obj As Object
    
    If Dir(RESDB) <> "" Then Kill RESDB 'If database exists, it will be deleted
    
    Access.DBEngine.CreateDatabase RESDB, DB_LANG_GENERAL 'Create new database
    
    For Each tdf In CurrentDb.TableDefs
        If Left(tdf.Name, 4) <> "MSys" Then    'Ignore system tables
            DoCmd.TransferDatabase acExport, "Microsoft Access", RESDB, acTable, tdf.Name, tdf.Name, False
        End If
    Next tdf
SExit:
    On Error Resume Next
    Set tdf = Nothing
    Set obj = Nothing
    Exit Sub
 
Errors:
    MsgBox "Error Number/Descriotion: " & Err.Number & " / " & Err.Description
    Resume SExit
End Sub

Open in new window

replace your lines:
Set fs = CreateObject("Scripting.FileSystemObject")
               fs.CopyFile strSourceFile & "\" & strSourceName, strBu
            Set fs = Nothing

with:
ExportTables (strBu  & "\" & strSourceName)
Avatar of Ronald Malk
Ronald Malk
Flag of Australia image

ASKER

Thanks for the reply
Actually I replaced As you said:
Set fs = CreateObject("Scripting.FileSystemObject")
               fs.CopyFile strSourceFile & "\" & strSourceName, strBu
            Set fs = Nothing
with:
ExportTables (strBu  & "\" & strSourceName)

but I'm having compile issue with the new replacement line :
this is what I did:
Function fMakeBackup()
Dim strBu As String
   Dim buf As String
      Dim MD_Date As Variant
         Dim fs As Object
            Dim strSourceName As String
               Dim strSourceFile As String
                  Const conPATH_FILE_ACCESS_ERROR = 75

strSourceName = CurrentProject.Name
strSourceFile = CurrentProject.Path
buf = "C:\WinRef\"

   If GetAttr(buf) <> vbDirectory Then
   MkDir buf
   End If
   
MD_Date = "HCS" & Format(Date, "yyyy-mm-dd-") & Format(Time, "hh-mm-ss")
strSourceFile = CurrentProject.Path

strBu = "C:\WinRef\" & MD_Date & "\"
    MkDir (strBu)
         
ExportTables (strBu & "\" & strSourceName)

End Function
Avatar of als315
als315
Flag of Russian Federation image
Where is your problem? Can you show error? Did you placed sub into module?
Avatar of Ronald Malk
Ronald Malk
Flag of Australia image

ASKER

Yes it's in a module.
the error in the replacement line below

ExportTables (strBu & "\" & strSourceName)
Avatar of als315
als315
Flag of Russian Federation image
Please, show error (screenshot)
ASKER CERTIFIED SOLUTION
Avatar of als315
als315
Flag of Russian Federation image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Ronald Malk
Ronald Malk
Flag of Australia image

ASKER

Even with the example attachment I'm Having a weird problem
Please have a look at the attachment

User generated imageUntitled2.png
SOLUTION
Avatar of Dale Fye
Dale Fye
Flag of United States of America image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Ronald Malk
Ronald Malk
Flag of Australia image

ASKER

Finally I got it working! I copied the module and the sub of the example file.
Many thanks for your help.
Avatar of Ronald Malk
Ronald Malk
Flag of Australia image

ASKER

Thank you, I wouldn't be able to do it without the Attachment file