Compact/Backup & ZIP

[Sevn]

Hello All,

I have a standalone DB (2007) that I typically import, compact, ZIP, and email to several people every morning.

This is NOT a frontend/backend DB. Everything is contained within one file (InvoiceAudit...accdb).

I have searched far and wide for some code to automate this process, but keep coming up short on one piece or another. I have pasted the different code snippets that I have tried, and the results.

This one doesn't perform the compact, but does the email. When the DB is closed, it then performs the compact. This won't work, since the ZIP command is looking for something that isn't there yet (...\Database.mdb)

Public Function EmailInvoiceAudit()

Dim fs, currentfile, currentsize, filespec
Dim strProjectPath As String, strProjectName As String

        strProjectPath = Application.CurrentProject.Path
        strProjectName = Application.CurrentProject.Name
        filespec = strProjectPath & "\" & strProjectName
        
    Kill strProjectPath & "\Database.mdb"
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set currentfile = fs.GetFile(filespec)
        currentsize = CLng(currentfile.Size / 1000000)
            If currentsize > 5 Then
                Application.SetOption ("Auto Compact"), 1 'compact current file
            Else
                Application.SetOption ("Auto Compact"), 0 'do nothing
            End If

Dim olapp As Object
Dim olns As Object
Dim olfolder As Object
Dim olitem As Object
Dim olattach As Object
Dim cp As XZip.Zip '** Archive files

    Set cp = New XZip.Zip
      cp.Pack "S:\Pricing\InvoiceAudit\Database.mdb", "S:\Pricing\InvoiceAudit\Exports\Temp\InvoiceAudit.zip" ', False, , 9

    Set olapp = CreateObject("Outlook.Application")
    Set olns = olapp.GetNamespace("MAPI")
    Set olfolder = olns.getdefaultfolder(6)
    Set olitem = olapp.createitem(0)
    Set olattach = olitem.attachments

       olitem.To = "youngje@compassminerals.com"
       olitem.CC = ""
       olitem.Subject = "Invoice Audit for " & Date - 1
       olitem.body = "Hello," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Please find enclosed the daily Invoice Audits" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Thanks," & Chr(13) & Chr(10) & "Jerrod"
       olattach.Add "S:\Pricing\InvoiceAudit\Exports\Temp\InvoiceAudit.zip", 1
       olitem.display
       olitem.send

    Set olitem = Nothing
    Set rs = Nothing
    Set Db = Nothing
    Set olfolder = Nothing
    Set olns = Nothing
    Set olapp = Nothing
    Set cp = Nothing

End Function

I tried to compact the DB first with this code, but it apparently isn't compatible with 2007.

Private Sub cmdEmail_Click()
   CommandBars("Menu Bar"). _
   Controls("Tools"). _
   Controls("Database utilities"). _
   Controls("Compact and repair database..."). _
   accDoDefaultAction
End Sub

I tried this one, but it tells me the database is open.

Private Sub cmdEmail2_Click()

Dim SysDataPath As String
Dim SysMDBName As String

SysDataPath = Application.CurrentProject.Path
SysMDBName = Application.CurrentProject.Name

'Compact the database to a temp name
    DBEngine.CompactDatabase SysDataPath & "\" & SysMDBName & ".accdb", SysDataPath & "\" & SysMDBName & "Old.accdb"
    DoEvents
                
'Check to see if the file has been created
    If Dir(SysDataPath & "\" & SysMDBName & "Old.accdb") <> "" Then
                    
        'Delete the original mdb
            Kill SysDataPath & "\" & SysMDBName & ".accdb"
        'Run the compact again back to its original name
            DBEngine.CompactDatabase SysDataPath & "\" & SysMDBName & "old.accdb", SysDataPath & "\" & SysMDBName & ".accdb"
            DoEvents
                    
        'Delete the old copy
            Kill SysDataPath & "\" & SysMDBName & "Old.accdb"
            DoEvents
    Else
        'Did the compact work?
            If MsgBox("A problem occured creating the initial compacted file." & vbCrLf & vbCrLf & "click OK to continue without compacting the database or Cancel to exit the backup facility.", vbExclamation + vbOKCancel, "Problem occured") = vbCancel Then
                Exit Sub
                    
            End If
    End If
                
Dim cp As XZip.Zip
Set cp = New XZip.Zip
    'Create the zip file
        cp.Pack SysDataPath & "\" & SysMDBName & ".accdb", SysDataPath & "\" & Date - 1 & SysMDBName & ".zip"
Set cp = Nothing
            
    MsgBox "Backup complete, click Ok to continue.", vbInformation + vbOKOnly, "Database Backup Routine"


End Sub

I tried this in conjunction with a function, but the function doesn't get recognized.

Private Sub Command9_Click()
CompactCurrentFile

Dim olapp As Object
Dim olns As Object
Dim olfolder As Object
Dim olitem As Object
Dim olattach As Object
Dim cp As XZip.Zip '** Archive files

    Set cp = New XZip.Zip
      cp.Pack "S:\Pricing\InvoiceAudit\Database.accdb", "S:\Pricing\InvoiceAudit\Exports\Temp\InvoiceAudit.zip" ', False, , 9

    Set olapp = CreateObject("Outlook.Application")
    Set olns = olapp.GetNamespace("MAPI")
    Set olfolder = olns.getdefaultfolder(6)
    Set olitem = olapp.createitem(0)
    Set olattach = olitem.attachments

       olitem.TO = "youngje@compassminerals.com"
       olitem.CC = ""
       olitem.Subject = "Invoice Audit for " & Date - 1
       olitem.body = "Hello," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Please find enclosed the daily Invoice Audits" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Thanks," & Chr(13) & Chr(10) & "Jerrod"
       olattach.Add "S:\Pricing\InvoiceAudit\Exports\Temp\InvoiceAudit.zip", 1
       olitem.display
       olitem.send

    Set olitem = Nothing
    Set rs = Nothing
    Set Db = Nothing
    Set olfolder = Nothing
    Set olns = Nothing
    Set olapp = Nothing
    Set cp = Nothing

End Sub

I am past frustrated with this, and need to know if what I'm trying to do is even possible. Can someone please guide me in the right direction, or let me know if this is even possible?

Any help will be greatly appreciated.

Thanks,

 

[jal]

I think you can compact to a newly created file like this:

Application.CompactRepair(strSource, strDest)

I've never tried it though.

 

[Sevn]

Hello,

Thanks for your reply, but that method can't be performed on an open DB.

http://www.blueclaw-db.com/compactrepair.htm

 

[jal]

Here's a method I used once or twice:
'Add a reference to Micosoft Jet and replication library

Private Sub compactTheDb()
Dim fso As New IWshRuntimeLibrary.FileSystemObject
Dim pathToContainingFolder As String
If Not fso.FileExists(strPathToDB) Then Exit Sub
pathToContainingFolder = fso.GetFile(strPathToDB).ParentFolder.path
'Compact to the following destination
Dim pathToDestDB As String
pathToDestDB = Replace(strPathToDB, ".mdb", "-Compacted.mdb")
If fso.FileExists(pathToDestDB) Then fso.DeleteFile (pathToDestDB)
Dim JRO As New JRO.JetEngine
Dim DBEngine As New DAO.DBEngine
Dim DB As DAO.Database
Set DB = DBEngine.OpenDatabase(strPathToDB)
DB.Close
'To compact, specify the connection to the source db, and the connection to the destination db
Dim cnStringDest As String
cnStringDest = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= " & pathToDestDB & ";Jet OLEDB:Engine Type=5"
Call JRO.CompactDatabase(strCn, cnStringDest)
fso.CopyFile pathToDestDB, strPathToDB 'overwrites the swelled db with the compact db
End Sub

 

[Mike375]

The attached might help. I don't have the site link handy at the moment but it might be in the code. Works like a charm in A 2003 and will Zip while the DB is open.

The UnZip32 and Zip32 are DLL files that need to reside in the same folder as Zip. The Zip is a small DB. I extracted the bits and put them in my own DB. I mainly use it for my backup when the DB is open as I run the Zip part and then that is copied to the external drives and computers in the network with date/time stamp.

You can run the Zip as a stand alone DB. Whether used in your DB or as stand a lone the two textboxes that open for From and Where To can be set so it defaults to the file and drive you want.

I got this of member here on another thread. I will gi back and try and find it.

 

[Mike375]

Here is a link to the thread where I got it. A few posts down Shadow9449 has posted the link to it

http://www.access-programmers.co.uk/forums/showthread.php?t=162705&highlight=Zip

 

[MSAccessRookie]

Hello,

Thanks for your reply, but that method can't be performed on an open DB.

http://www.blueclaw-db.com/compactrepair.htm

Does it need to be done from the DB itself? Can't you make a new DB with the sole purpose of doing these things to another Foreign (and closed) Database?

 

[Sevn]

Here's a method I used once or twice:
'Add a reference to Micosoft Jet and replication library

Private Sub compactTheDb()
Dim fso As New IWshRuntimeLibrary.FileSystemObject
Dim pathToContainingFolder As String
If Not fso.FileExists(strPathToDB) Then Exit Sub
pathToContainingFolder = fso.GetFile(strPathToDB).ParentFolder.path
'Compact to the following destination
Dim pathToDestDB As String
pathToDestDB = Replace(strPathToDB, ".mdb", "-Compacted.mdb")
If fso.FileExists(pathToDestDB) Then fso.DeleteFile (pathToDestDB)
Dim JRO As New JRO.JetEngine
Dim DBEngine As New DAO.DBEngine
Dim DB As DAO.Database
Set DB = DBEngine.OpenDatabase(strPathToDB)
DB.Close
'To compact, specify the connection to the source db, and the connection to the destination db
Dim cnStringDest As String
cnStringDest = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= " & pathToDestDB & ";Jet OLEDB:Engine Type=5"
Call JRO.CompactDatabase(strCn, cnStringDest)
fso.CopyFile pathToDestDB, strPathToDB 'overwrites the swelled db with the compact db
End Sub

jal,

I added the Jet Ref, and your code, and get the following:
Compile Error: User-defined type not defined.

The only thing I changed was the file extension from mdb to accdb.

Any ideas why this is?

I will try some of the other suggestions in the meantime.

 

[jal]

The file system object is in two different libaries. The one I used is Windows Scripting Host. The other library is Microsoft Scripting Runtime. If your prefer that one, then use

Dim fso as New Scripting.FilingSystemObject

 

[jal]

Actually I don't recall attempting this from Access. I used it on a Jet database created from the MS Outlook VBA environment. Don't know if my code will work in your scenario.

 

[Sevn]

The attached might help. I don't have the site link handy at the moment but it might be in the code. Works like a charm in A 2003 and will Zip while the DB is open.

The UnZip32 and Zip32 are DLL files that need to reside in the same folder as Zip. The Zip is a small DB. I extracted the bits and put them in my own DB. I mainly use it for my backup when the DB is open as I run the Zip part and then that is copied to the external drives and computers in the network with date/time stamp.

You can run the Zip as a stand alone DB. Whether used in your DB or as stand a lone the two textboxes that open for From and Where To can be set so it defaults to the file and drive you want.

I got this of member here on another thread. I will gi back and try and find it.

Hello Mike375,

Thanks for the input, and it works perfectly.

Although; I prefer not to have the extra form. Is it possible to just use the MakeZip command without the form? I tried to use the following, but to no avail. It results into a syntax error on the MakeZip line.

Private Sub cmdZip_Click()
Dim dbPath As String
Dim dbname As String
Dim zipname As String

dbPath = Application.CurrentProject.Path
dbname = dbPath & "\InvoiceAudit-Ver1(3).accdb"
zipname = dbPath & "\InvoiceAudit-Ver1(3).zip"

MakeZip (dbname, zipname)

End Sub

 

[Mike375]

Although; I prefer not to have the extra form. Is it possible to just use the MakeZip command without the form?

I have not tried but will have a look a bit later.

All I did was to to add to the end of it so when clicked the pop up box at the end it opened a DB I have that is full of back up stuff and I added to that to do the Zipped file.

I think you should be able to by pass the form as that is (I think?) only to enter the path and them the button continues the code.

 

[HiTechCoach]

Hello Mike375,

Thanks for the input, and it works perfectly.

Although; I prefer not to have the extra form. Is it possible to just use the MakeZip command without the form? I tried to use the following, but to no avail. It results into a syntax error on the MakeZip line.

Private Sub cmdZip_Click()
Dim dbPath As String
Dim dbname As String
Dim zipname As String

dbPath = Application.CurrentProject.Path
dbname = dbPath & "\InvoiceAudit-Ver1(3).accdb"
zipname = dbPath & "\InvoiceAudit-Ver1(3).zip"

MakeZip (dbname, zipname)

End Sub

Try:

Private Sub cmdZip_Click()
Dim dbPath As String
Dim dbname As String
Dim zipname As String

dim Results as Boolean

dbPath = Application.CurrentProject.Path
dbname = dbPath & "\InvoiceAudit-Ver1(3).accdb"
zipname = dbPath & "\InvoiceAudit-Ver1(3).zip"

Results  = MakeZip (dbname, zipname)

End Sub

Better would be to use some error handling:

Private Sub cmdZip_Click()
Dim dbPath As String
Dim dbname As String
Dim zipname As String


dbPath = Application.CurrentProject.Path
dbname = dbPath & "\InvoiceAudit-Ver1(3).accdb"
zipname = dbPath & "\InvoiceAudit-Ver1(3).zip"

      If MakeZip (dbname, zipname) = False Then
      
         MsgBox "Zip file creation error!", vbCritical, "Error ..."
         
      End If



End Sub

 

[dfenton]

Here's a method I used once or twice:
'Add a reference to Micosoft Jet and replication library

Why use JRO for functionality that is already provided by DAO? That is, you can compact a database with DAO -- I see nothing at all in your code that is provided by JRO that is not available in DAO. The whole reason JRO exists is because of MS's misguided campaign to push Access developers to use ADO as the default data access interface for Jet data. JRO was created to cover the handful of Jet-specific functions that ADO did not cover (because ADO is a generic db interface). Using DAO for part of your code and JRO for other parts just seems completely nonsensical -- you've added an additional reference without gaining any actual new functionality.

Also, I'd recommend against adding a reference to the FileSystem Object -- it's much better to use late binding.

 

[jal]

Why use JRO for functionality that is already provided by DAO? That is, you can compact a database with DAO -- I see nothing at all in your code that is provided by JRO that is not available in DAO. The whole reason JRO exists is because of MS's misguided campaign to push Access developers to use ADO as the default data access interface for Jet data. JRO was created to cover the handful of Jet-specific functions that ADO did not cover (because ADO is a generic db interface). Using DAO for part of your code and JRO for other parts just seems completely nonsensical -- you've added an additional reference without gaining any actual new functionality.

This thread began with some DAO code that apparently wasn't working for the user. I was simply regurgitating any possible alternative that came to mind, in the hope of helping him solve his problem.

Also, I'd recommend against adding a reference to the FileSystem Object -- it's much better to use late binding.

Is that always the case, or just for this scenario, and why?

I mean, at least in performance-intensive scenarios (which this is not), I prefer early binding for faster execution.

 

[Sevn]

Try:

Private Sub cmdZip_Click()
Dim dbPath As String
Dim dbname As String
Dim zipname As String

dim Results as Boolean

dbPath = Application.CurrentProject.Path
dbname = dbPath & "\InvoiceAudit-Ver1(3).accdb"
zipname = dbPath & "\InvoiceAudit-Ver1(3).zip"

Results  = MakeZip (dbname, zipname)

End Sub

Better would be to use some error handling:

Private Sub cmdZip_Click()
Dim dbPath As String
Dim dbname As String
Dim zipname As String


dbPath = Application.CurrentProject.Path
dbname = dbPath & "\InvoiceAudit-Ver1(3).accdb"
zipname = dbPath & "\InvoiceAudit-Ver1(3).zip"

      If MakeZip (dbname, zipname) = False Then
      
         MsgBox "Zip file creation error!", vbCritical, "Error ..."
         
      End If



End Sub

Ok, I tried

Private Sub cmdEmail_Click()
Dim dbPath As String
Dim dbname As String
Dim zipname As String

dbPath = Application.CurrentProject.Path
dbname = dbPath & "\InvoiceAudit-Ver1(3).accdb"
zipname = dbPath & "\InvoiceAudit-Ver1(3).zip"

      If MakeZip(dbname, zipname) = False Then
      
         MsgBox "Zip file creation error!", vbCritical, "Error ..."
         
      End If

End Sub

and I received a Compile Error: Sub or Function not defined. MakeZip is highlighted.

Question: How can dbname ever equal zipname if they have different extensions? Wouldn't the statement always be false?

I would prefer to use something like your script, but I think I figured out an alternative...

I will just mock up a similar setup of that provided in the Zip.Zip from Mike375. All I should have to do is create 2 hidden text boxes (on the menu/switchboard), set the DB path & ZIP path as default values to load on open, and set the button up to zip, and email the remaining piece of the process. This should bring the total process to one button. I will post back as to whether my assumptions are correct.

 

[Sevn]

Ok, I have exported/imported all of the modules from the ZIP DB into my DB, and added all of the form code from the VBA window for ZIP DB to my DB.

Here is the code for my form.

Option Compare Database

Private Sub cmdEmail_Click()

   Me.lblMsg.Visible = True
   DoEvents
   
   
      If MakeZip(Me.txtIn, Me.txtOut) = True Then
      
         MsgBox "Zip file created", vbInformation, "Access Zip"
         
      End If
   Me.lblMsg.Visible = False
      
End Sub

Private Sub Form_Load()

    Dim dbPath As String
    Dim dbname As String
    Dim strZipFile As String
    Dim intDot As Integer
    
    dbPath = Application.CurrentProject.Path
    dbname = dbPath & "\InvoiceAudit-Ver1(3).accdb"
    
    Me.txtIn = dbname

   ' we use this file name for a "default"
   ' zip file
   
   ' remove the .mdb/mde/accdb extension..and replace it with zip...
   
   strZipFile = Me.txtIn
   intDot = InStr(strZipFile, ".")
   If intDot <> 0 Then
      strZipFile = Left(strZipFile, intDot) & "zip"
      Me.txtOut = strZipFile
   End If
    
End Sub

Private Sub Command7_Click()
On Error GoTo Err_Command7_Click


    DoCmd.Close

Exit_Command7_Click:
    Exit Sub

Err_Command7_Click:
    MsgBox Err.Description
    Resume Exit_Command7_Click
    
End Sub

I get the following error when the procedure is ran:
Compile Error: Method or Data Member not Found

I attached a screen shot of the error.

Any assistance with this is will be greatly appreciated.

 

[dfenton]

This thread began with some DAO code that apparently wasn't working for the user. I was simply regurgitating any possible alternative that came to mind, in the hope of helping him solve his problem.

The original problem was trying to compact the currently open database, which is not possible with any method, including JRO.

(in regard to using FSO with late binding

Is that always the case, or just for this scenario, and why?

I mean, at least in performance-intensive scenarios (which this is not), I prefer early binding for faster execution.

I recommend late binding with all non-native Access libraries because the native default libraries are self-healing, i.e., if the libraries are not in the same place, Access automatically fixes it.

As to performance, early binding gets you only fast initialization, but once initialized, no faster performance. So, if you need to repeatedly use the FSO, initialize a global object variable that points to the FSO, and then repeatedly use that. It's silly to continually re-initialize it if you're going to use it repeatedly, but initializing it via late binding means your app won't break if it's in a non-default location, *and* you can recover from scenarios in which the FSO/WSCRIPT is disallowed by policy, since the initialization will fail. That's a recoverable condition, whereas with early binding, it's not.

So, in short:

1. Late binding makes your app more robust

2. It has no performance hit *if* you code to initialize it only once.

 

[dfenton]

I get the following error when the procedure is ran:
Compile Error: Method or Data Member not Found

I attached a screen shot of the error.

The line in your code that causes the error is:

   Me.lblMsg.Visible = True

This simply indicates that you don't have a label on your form named "lblMsg". You need to either remove all references to that in your code, or add a label with that name to your form.

 

[jal]

I recommend late binding with all non-native Access libraries because the native default libraries are self-healing, i.e., if the libraries are not in the same place, Access automatically fixes it.

I thought that's where you were going. That seems pretty sound to me.

As to performance, early binding gets you only fast initialization, but once initialized, no faster performance.

Here I'm a little skeptical. When you write

Dim FSO as Object

You enable FSO to be ANY object, meaning that one moment it can be a FileSystemObject and the next moment it can be a form, textbox, combobox or whatever - all these changes in the same loop. Therefore I suspect that the runtime will need to keep rechecking the "FSO" to verify that the current set of properties and methods is the same. This seems to be what Microsoft is stating:

Each time you invoke a property or method with late binding, Visual Basic passes the member name to the GetIDsOfNames method of the object’s IDispatch interface.
http://msdn.microsoft.com/en-us/library/aa241755(VS.60).aspx

Microsoft did not say, "This only happens once at inititialization." Rather they said, "EACH TIME".

Every article I've seen on late-binding to date says that it's slower. I've never seen an article that says, "It's only slower at initialization." Please feel free to show me some articles that prove your point.