[AccessD] What you don't think about

Hi John,

This is code I use to zip a file - collected from pieces across the
internet.  
Also, the code below is used to set or clear the read only flag of a file.
To find out if a file is read-only or not, just read the file's attribute.

Maybe there's something here that would be useful.

Dan

'----------------------------------------
Private Sub ZipOneFile_TEST()

    Call
ZipOneFile("E:\Consulting\Clients\DON\PSISystemDEV\BackEnd\BackupFiles\PSIDO
NBE.mdb", "E:\Consulting\Clients\DON\PSISystemDEV\BackEnd\BackupFiles")

End Sub

Public Sub ZipOneFile(varSourceFileFullPath As Variant, stgTargetFolder As
String, Optional blnUseOriginalFileName As Boolean = False)

    '-- Note: The stgSourceFileFullPath must be a variant for the .CopyHere
method to work

    Dim objShell As Object
    Dim stgDate As String
    Dim stgFileNameZip As String
    Dim fso As Object

    DoEvents

    Set fso = CreateObject("Scripting.FileSystemObject")

    '-- To ensure a unique filename append date and time to the name of the
current file.
    If blnUseOriginalFileName = False Then
        stgDate = Format(Now, "_yyyy-mm-dd") & Format(Now, "_hhmm")
    End If
    stgFileNameZip = fso.GetBaseName(varSourceFileFullPath) & stgDate &
".zip"

    '-- Create the empty Zip file.
    Call InitializeZipFile(stgTargetFolder & "\" & stgFileNameZip)

    '-- Copy the file to the compressed folder.
    Set objShell = CreateObject("Shell.Application")
    objShell.Namespace(stgTargetFolder & "\" & stgFileNameZip).CopyHere
varSourceFileFullPath, &H0&

    '-- Keep script waiting until Compressing is done
    On Error Resume Next
    Do Until objShell.Namespace(stgTargetFolder & "\" &
stgFileNameZip).Items.Count = 1
        Sleep 500
    Loop
    On Error GoTo 0

    Set objShell = Nothing

End Sub

Private Sub InitializeZipFile_TEST()

    '    Call InitializeZipFile("C:\PSISystemClient\spreadsheets\LOS
Turnback Data 10-19-2011 11316.xlsx")

End Sub

Private Sub InitializeZipFile(stgZipFile As String)

    '-- This code uses the Open statement to enable output to the file
(thereby creating the file), _
     and the Print statement to write the twenty-two byte signature to it.

    Dim intFile As Integer
    Dim fso As FileSystemObject

    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(stgZipFile) Then Exit Sub
    If fso.FolderExists(stgZipFile) Then Exit Sub

    If Len(Dir(stgZipFile)) > 0 Then Kill stgZipFile

    intFile = FreeFile

    Open stgZipFile For Output As #intFile

    Print #intFile, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)

    Close #intFile

End Sub
'----------------------------------------

'----------------------------------------
Public Sub SetReadOnly(stgFullPath As String)

    '-- Purpose: Set a file to read only

    Dim fso As FileSystemObject
    Dim fProperties As Object

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fProperties = fso.GetFile(stgFullPath)
    fProperties.Attributes = 1

    Set fProperties = Nothing
    Set fso = Nothing

End Sub

Public Sub ClearReadOnly(stgFullPath As String)

    '-- Purpose: Clear the read only flag on a file

    Dim fso As FileSystemObject
    Dim fProperties As Object

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fProperties = fso.GetFile(stgFullPath)
    fProperties.Attributes = 0

    Set fProperties = Nothing
    Set fso = Nothing

End Sub
'----------------------------------------
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of John W Colby
Sent: Thursday, May 30, 2013 1:43 PM
To: Access Developers discussion and problem solving
Subject: [AccessD] What you don't think about

I grabbed some code off the internet to check if a file is locked. The code
was (too) simple, and just tried to open the file read/write.  If it
succeeded the file is not locked.  Sounds good right?

Well... if the file does not exist then it CREATES the file! Ooops.  I had
to add a "wrapper" to do a DIR() to see if the file exists, and if not
return a false (not locked since it doesn't exist) else try to open it.

The code I was building was some stuff to use FSO to zip a file and that is
just flaky, but doesn't require external dlls.  The code creates the zip
file (directory really) if it doesn't exist and then stuffs the file in it.
Except that my lock check was creating the file before this code ever got a
chance to do so.

I scratched my head over that one for a good while.

And of course all of this was buried way down in other code that had to run
first...

BTW, some of you may remember my timer class.  This zip code was using a
call out to Windows to Sleep().  Unfortunately Sleep causes the user
interface to go unresponsive during the Sleep.  So I added a function to my
timer class mSleep(lngMSToSleep as long) and then used the timer stuff to
watch the timer for that many milliseconds in a while loop, but calling
DoEvents inside of that loop.  It looks like a sleep but the DoEvents allows
Windows to process the event queue for the app so I can still move around in
the app and do things while the code is "sleeping".

--
John W. Colby

Reality is what refuses to go away
when you do not believe in it

--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com