ajout module zip

source/database.properties

@@ -38,3 +38,4 @@ NavPane View By	0	4
 NavPane Sort By	1	4
 AppTitle	FonctionsVBACommunes	10
 StartUpForm	f_about	10
+AppIcon	C:\dev\access\AccessToolbox\logo.png	10

source/modules/AT_Access.bas

@@ -64,6 +64,7 @@ Public Function form_exists(fname As String) As Boolean
         End If
     Next frm
 
+fin:
 End Function
 
 Public Function report_exists(rname As String) As Boolean
@@ -77,6 +78,7 @@ Public Function report_exists(rname As String) As Boolean
         End If
     Next rpt
 
+fin:
 End Function
 
 Public Function form_is_opened(fname As String) As Boolean
@@ -93,4 +95,9 @@ Public Function report_is_opened(rname As String) As Boolean
     If Not report_exists(rname) Then Exit Function
     report_is_opened = CurrentProject.AllReports(rname).IsLoaded
     
+End Function
+
+Public Function is_opened(objtype As Integer, objname As String) As Boolean
+    is_opened = False
+    IsTableOpened = SysCmd(acSysCmdGetObjectState, objtype, objname)
 End Function

source/modules/AT_Collections.bas

@@ -36,7 +36,7 @@ Dim var As Variant
 is_empty = True
 
 On Error Resume Next
-var = UBound(Tableau)
+var = UBound(iterable)
 On Error GoTo 0
 
 is_empty = IsEmpty(var)

source/modules/AT_FileOp.bas

@@ -122,20 +122,20 @@ Public Function list_files_in(ByVal dirpath As String, Optional ByVal filter As
     
 End Function
 
-Public Function read_file(filepath As String, Optional encoding As String = "utf-8") As String
+Public Function read_file(filePath As String, Optional encoding As String = "utf-8") As String
     Dim objStream As ADODB.Stream
     Set objStream = New ADODB.Stream
 
     objStream.Charset = encoding
     objStream.Open
-    objStream.LoadFromFile (filepath)
+    objStream.LoadFromFile (filePath)
     ReadFile = objStream.ReadText()
     
     objStream.Close
     Set objStream = Nothing
 End Function
 
-Public Sub make_file(filepath As String, content As String, Optional encoding As String = "utf-8")
+Public Sub make_file(filePath As String, content As String, Optional encoding As String = "utf-8")
     Dim objStream As ADODB.Stream
     
     Set objStream = CreateObject("ADODB.Stream")
@@ -143,7 +143,7 @@ Public Sub make_file(filepath As String, content As String, Optional encoding As
     objStream.Type = 2 'Text
     objStream.Charset = encoding
     objStream.WriteText content
-    objStream.SaveToFile (filepath)
+    objStream.SaveToFile (filePath)
     objStream.Close
 
 End Sub
@@ -169,14 +169,14 @@ Public Function is_valid_filename(ByVal sName As String) As Boolean
                         
 End Function
 
-Public Function run_file(filepath As String, Optional args As String = "")
+Public Function run_file(filePath As String, Optional args As String = "")
 
-    Shell "cmd.exe /r start " & filepath & " " & args, vbHide
+    Shell "cmd.exe /r start " & filePath & " " & args, vbHide
 
 End Function
 
-Public Sub open_file(filepath As String)
+Public Sub open_file(filePath As String)
 
-    Application.FollowHyperlink filepath
+    Application.FollowHyperlink filePath
 
 End Sub

source/modules/AT_Zip.bas

@@ -0,0 +1,45 @@
+' Add reference to:
+' 1. Microsoft Scripting Runtime
+' 2. Microsoft Shell Controls and Automation
+' From Tools > Reference
+
+Option Explicit
+Option Base 0
+
+Private Declare Sub Sleep Lib "kernel32" (ByVal dwMiliseconds As Long)
+
+Public Sub zipfile(zipPath As String, filePath As String)
+  createzip zipPath
+  addfile zipPath, filePath
+End Sub
+
+Public Sub zipfolder(zipPath As String, folderpath As String)
+  Dim file As Variant
+  createzip zipPath
+  For Each file In CreateObject("Scripting.FileSystemObject").GetFolder(folderpath).Files
+      addfile zipPath, CStr(file)
+  Next file
+End Sub
+
+Private Sub addfile(zipPath As String, filePath As String)
+  Dim sh As Shell32.Shell, fdr As Shell32.Folder, cntItems As Integer 'cnt = Count
+  Set sh = CreateObject("Shell.Application")
+  Set fdr = sh.NameSpace(zipPath)
+  cntItems = fdr.Items.Count
+  fdr.CopyHere filePath, 4 + 16 + 1024
+  Do
+    Sleep 1000
+  Loop Until cntItems < fdr.Items.Count
+  Set fdr = Nothing
+  Set sh = Nothing
+End Sub
+
+Private Sub createzip(zipPath As String)
+  Dim fso As Scripting.FileSystemObject
+  Set fso = CreateObject("Scripting.FileSystemObject")
+  If fso.FileExists(zipPath) Then
+    fso.DeleteFile zipPath
+  End If
+  fso.CreateTextFile(zipPath).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
+  Set fso = Nothing
+End Sub

source/modules/TextFile.bas

@@ -25,20 +25,20 @@ End Property
 Public Sub create_file(Optional path As String = "")
 Dim ref As Variant
 
-  If Len(chemin) > 0 Then loc_path = chemin
+  If Len(path) > 0 Then loc_path = path
   loc_ref = FreeFile(1)
-  Open loc_path For Append Access Write Shared As locRef
+  Open loc_path For Append Access Write Shared As loc_ref
 
 End Sub
 
 Public Sub write_line(str As String)
-  Print #locRef, str
+  Print #loc_ref, str
 End Sub
 
 Public Sub close_file()
-  Close #locRef
+  Close #loc_ref
 End Sub
 
 Private Sub class_Terminate()
-  Close #locRef
+  Close #loc_ref
 End Sub

source/modules/TimerObject.bas

@@ -23,6 +23,7 @@ Public Sub start()
 End Sub
 
 Public Function current() As Long
+  Dim valeur As Long
   valeur = 1000 * (Timer - t0)
 End Function
 

source/references.csv

@@ -8,3 +8,4 @@
 {00000300-0000-0010-8000-00AA006D2EA4},6,0
 {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52},2,5
 {420B2830-E718-11CF-893D-00A0C9054228},1,0
+{50A7E9B0-70EF-11D1-B75A-00A0C90564FE},1,0