Automatically zipping a file

sparx

Morphed Human
Local time
Today, 15:42
Joined
Jul 22, 2002
Messages
80
Is there a way, I'm sure there is cuz Access can do it all, to automatically zip a specified file. I would like to zip it as soon as I export it. Any help would be greatly appreciated

Thanks,

Erik
 
This is what I use to zip and backup the open db file with WinZip from Access. You should be able to easily modify it to meet your needs.

Public Function BackupAndZipit()

'This function will allow you to copy a db that is open,
'rename the copied db and zip it up to anther folder.

'You must set a reference to the 'Microsoft Scripting Runtime' for the CopyFile piece to work!

'Thanks to Ricky Hicks for the .CopyFile code

Dim fso As FileSystemObject

Dim sSourcePath As String
Dim sSourceFile As String
Dim sBackupPath As String
Dim sBackupFile As String

sSourcePath = "C:\Database\"
sSourceFile = "MyDB.mdb"
sBackupPath = "C:\Database\Backups\"
sBackupFile = "BackupDB_" & Format(Date, "mmddyyyy") & "_" & Format(Time, "hhmmss") & ".mdb"

Set fso = New FileSystemObject
fso.CopyFile sSourcePath & sSourceFile, sBackupPath & sBackupFile, True
Set fso = Nothing

Dim sWinZip As String
Dim sZipFile As String
Dim sZipFileName As String
Dim sFileToZip As String

sWinZip = "C:\Program Files\WinZip\WinZip32.exe" 'Location of the WinZip program
sZipFileName = Left(sBackupFile, InStr(1, sBackupFile, ".", vbTextCompare) - 1) & ".zip"
sZipFile = sBackupPath & sZipFileName
sFileToZip = sBackupPath & sBackupFile

Call Shell(sWinZip & " -a " & sZipFile & " " & sFileToZip, vbHide)

Beep
MsgBox "Backup was successful and saved @ " & Chr(13) & Chr(13) & sBackupPath & Chr(13) & Chr(13) & "The backup file name is " & Chr(13) & Chr(13) & sZipFileName, vbInformation, "Backup Completed"

If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)

End Function

HTH
 
Thanks GHudson, worked like a charm. I was able to modify the code to fit my need and everything works as planned, thanx a bunch

Erik
 
PROBLEM

Actually, there seems to be a problem when the directory of the source file has spaces
eg. strSourcePath = "C:\Program Files\Sfiler\Cft\Upload\"

It crashes because of the space between 'Program' and 'Files', any ideas??

Thanks

Erik
 
paste the code below into a basic module:
Code:
Declare Function GetShortPathName Lib "kernel32" _
      Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
      ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

   Public Function GetShortName(ByVal sLongFileName As String) As String
       Dim lRetVal As Long, sShortPathName As String, iLen As Integer
       'Set up buffer area for API function call return
       sShortPathName = Space(255)
       iLen = Len(sShortPathName)

       'Call the function
       lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
       'Strip away unwanted characters.
       GetShortName = Left(sShortPathName, lRetVal)
   End Function

and then call the above function like the following from anywhere in your project:
Code:
dim strLongName as string
dim strShortname as string
strLongName = "C:\Program Files\Sfiler\Cft\Upload\" 
strShortName = GetShortName (strLongName)
msgbox strShortName

this example should return something like "C:\Progra~1\Sfiler\Cft\Upload\"
 
Thanks a million Calvin, you are truly a lifesaver.

Have a beer on me,

Erik
 
Calvin, I can not get your code to work with Access 97 and Windows XP.
My second message box is displaying a blank message box.
Any suggestions? Thanks!
Code:
Declare Function GetShortPathName Lib "kernel32" _
      Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
      ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
    
Public Function test()
    Dim strLongName As String
    Dim strShortName As String
    strLongName = "C:\Program Files\Test Folder\Programs\Files\"
    strShortName = GetShortName(strLongName)
    MsgBox strLongName
    MsgBox strShortName
End Function
    
Public Function GetShortName(ByVal sLongFileName As String) As String
    Dim lRetVal As Long, sShortPathName As String, iLen As Integer
    'Set up buffer area for API function call return
    sShortPathName = Space(255)
    iLen = Len(sShortPathName)
    'Call the function
    lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
    'Strip away unwanted characters.
    GetShortName = Left(sShortPathName, lRetVal)
End Function
 
WinZip

GHudson,

I've tried your suggestion. Made the appropriate modifications for my db. It seems to run, returning a message that the file has been backedup. But when I go to the directory the db is suppose to be in, there is only a backup NOT a zip. Is this what this is suppose to do?

Thanks.
 
Carefully follow each step of my code and modify [remove what you do not want]. The last step is deleting the zip file.
 
ghudson,
Is "C:\Program Files\Test Folder\Programs\Files\" a valid path?

You have to pass it a valid LONG path for it to return a valid SHORT path (8.3 format).

The way it works is if you have multiple paths where the first six characters of the folder or file name are similar, it will determine an order alphabetically:
c:\Program Files\Microsoft Hardware\Mouse
c:\Program Files\Microsoft Office
c:\Program Files\Microsoft Office 2k
c:\Program Files\Microsoft Office 2k2
c:\Program Files\Microsoft SDK
c:\Program Files\Microsoft SQL Server
c:\Program Files\Microsoft Visual Studio
c:\Program Files\Microsoft Visual Studio .NET

the above LONG paths will be validated and returned as
c:\Progra~1\Micros~1\Mouse"
c:\Progra~1\Micros~2
c:\Progra~1\Micros~3
c:\Progra~1\Micros~4
c:\Progra~1\Micros~5
c:\Progra~1\Micros~6
c:\Progra~1\Micros~7
c:\Progra~1\Micros~8

I usually use this code in conjuction with the Common Dialog for opening files or establishing a folder path.

Sometime UNC network path will have problems and it may be better to use a mapped network path.
 
Thanks Calvin,

That was exactly my testing problem. The long path was not valid. Your function works great and will come in handy for Windows XP does not display the short names in the "properties" like earlier versions for Windows did. Thanks!
 
once again AW forums comes through for me, thanks for the help
 

Users who are viewing this thread

Back
Top Bottom