add a DeleteFolder function and implement this the Dump function

extend the function remove temp objects to include TempTables
tailormade-eu · Jun 16, 2020 · fa7986a · fa7986a
1 parent 7d79afa
commit fa7986a
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 36 deletions.
diff --git a/M_omFileFunctions.def b/M_omFileFunctions.def
@@ -53,6 +53,11 @@ End Sub
 Public Sub DeleteFile(filename As String, Optional force As Boolean = False)
     gFso.DeleteFile filename, force
 End Sub
+Public Sub DeleteFolder(folderName As String, Optional force As Boolean = False)
+    If omFileFunctions.FolderExists(folderName) Then
+        gFso.DeleteFolder folderName, force
+    End If
+End Sub
 
 Public Sub RenameFile(strOldName As String, strNewName As String, Optional strNewExtension As String = "")
 Dim strBackupName As String
@@ -210,11 +215,11 @@ Public Sub PrintFile(filename As String)
     CreateObject("Shell.Application").NameSpace(0).ParseName(filename).InvokeVerb ("Print")
 End Sub
 
-Public Sub WriteStringToFile(filename As String, s As String, Optional unicode As Boolean = False)
+Public Sub WriteStringToFile(filename As String, S As String, Optional unicode As Boolean = False)
 Dim ts As TextStream
 
     Set ts = gFso.CreateTextFile(filename, True, unicode)
-    ts.Write s
+    ts.Write S
     ts.Close
     Set ts = Nothing
 End Sub
diff --git a/M_omLibraryFunctions.def b/M_omLibraryFunctions.def
@@ -207,6 +207,7 @@ Dim rs As New ADODB.Recordset
 
     If objectType = acTable Or objectType = acDefault Then
         currentPath = gFso.BuildPath(path, "Tables")
+        omFileFunctions.DeleteFolder currentPath
         omFileFunctions.CreateFolderPath currentPath
         rs.Open "SELECT T.Name FROM MSysObjects T WHERE T.Type=1 AND T.Flags=0", CurrentProject.connection, adOpenForwardOnly, adLockReadOnly
         While Not rs.EOF
@@ -219,6 +220,7 @@ Dim rs As New ADODB.Recordset
 
     If objectType = acQuery Or objectType = acDefault Then
         currentPath = gFso.BuildPath(path, "Queries")
+        omFileFunctions.DeleteFolder currentPath
         omFileFunctions.CreateFolderPath currentPath
         For Each O In Application.CodeData.AllQueries
             omLibraryFunctions.SaveAsText acQuery, O.Name, gFso.BuildPath(currentPath, O.Name & ".txt")
@@ -227,6 +229,7 @@ Dim rs As New ADODB.Recordset
 
     If objectType = acForm Or objectType = acDefault Then
         currentPath = gFso.BuildPath(path, "Forms")
+        omFileFunctions.DeleteFolder currentPath
         omFileFunctions.CreateFolderPath currentPath
         For Each O In Application.CodeProject.AllForms
             omLibraryFunctions.SaveAsText acForm, O.Name, gFso.BuildPath(currentPath, O.Name & ".txt")
@@ -235,6 +238,7 @@ Dim rs As New ADODB.Recordset
 
     If objectType = acReport Or objectType = acDefault Then
         currentPath = gFso.BuildPath(path, "Reports")
+        omFileFunctions.DeleteFolder currentPath
         omFileFunctions.CreateFolderPath currentPath
         For Each O In Application.CodeProject.AllReports
             omLibraryFunctions.SaveAsText acReport, O.Name, gFso.BuildPath(currentPath, O.Name & ".txt")
@@ -243,6 +247,7 @@ Dim rs As New ADODB.Recordset
 
     If objectType = acModule Or objectType = acDefault Then
         currentPath = gFso.BuildPath(path, "Modules")
+        omFileFunctions.DeleteFolder currentPath
         omFileFunctions.CreateFolderPath currentPath
         For Each O In Application.CodeProject.AllModules
             omLibraryFunctions.SaveAsText acModule, O.Name, gFso.BuildPath(currentPath, O.Name & ".txt")
@@ -251,6 +256,7 @@ Dim rs As New ADODB.Recordset
 
     If objectType = acMacro Or objectType = acDefault Then
         currentPath = gFso.BuildPath(path, "Macros")
+        omFileFunctions.DeleteFolder currentPath
         omFileFunctions.CreateFolderPath currentPath
         For Each O In Application.CodeProject.AllMacros
             omLibraryFunctions.SaveAsText acMacro, O.Name, gFso.BuildPath(currentPath, O.Name & ".txt")
@@ -280,7 +286,6 @@ Dim tableName As String
     Select Case objectType
         Case acTable
             currentPath = fso.BuildPath(path, "Tables")
-            gFso.DeleteFolder currentPath
             For Each F In fso.GetFolder(currentPath).Files
                 If InStr(1, F.Name, "_Schema") = 0 Then
                     If Not silentMode Then
@@ -298,7 +303,6 @@ Dim tableName As String
             Next
         Case acModule
             currentPath = fso.BuildPath(path, "Modules")
-            gFso.DeleteFolder currentPath
             For Each F In fso.GetFolder(currentPath).Files
                 If F.Name <> "omLibraryFunctions.txt" Then
                     If Not silentMode Then
@@ -310,7 +314,6 @@ Dim tableName As String
             Next
         Case acQuery
             currentPath = fso.BuildPath(path, "Queries")
-            gFso.DeleteFolder currentPath
             For Each F In fso.GetFolder(currentPath).Files
                 If Not silentMode Then
                     Debug.Print "start : " & F.Name
@@ -320,7 +323,6 @@ Dim tableName As String
             Next
         Case acForm
             currentPath = fso.BuildPath(path, "Forms")
-            gFso.DeleteFolder currentPath
             For Each F In fso.GetFolder(currentPath).Files
                 If Not silentMode Then
                     Debug.Print "start : " & F.Name
@@ -330,7 +332,6 @@ Dim tableName As String
             Next
         Case acReport
             currentPath = fso.BuildPath(path, "Reports")
-            gFso.DeleteFolder currentPath
             For Each F In fso.GetFolder(currentPath).Files
                 If Not silentMode Then
                     Debug.Print "start : " & F.Name
@@ -340,7 +341,6 @@ Dim tableName As String
             Next
         Case acMacro
             currentPath = fso.BuildPath(path, "Macros")
-            gFso.DeleteFolder currentPath
             For Each F In fso.GetFolder(currentPath).Files
                 If Not silentMode Then
                     Debug.Print "start : " & F.Name
@@ -410,16 +410,16 @@ End Sub
 Public Sub VBAFindReplace(findString As String, replaceString As String, Optional silentMode As Boolean = True)
 Dim c As VBIDE.VBComponent
 Dim i As Long
-Dim s As String
+Dim S As String
 
     For Each c In VBE.ActiveVBProject.VBComponents
         For i = 1 To c.CodeModule.CountOfLines
-            s = c.CodeModule.Lines(i, 1)
-            If InStr(1, s, findString) > 0 Then
+            S = c.CodeModule.Lines(i, 1)
+            If InStr(1, S, findString) > 0 Then
                 If Not silentMode Then
-                    Debug.Print "In module: " & c.Name & " -> replaced: " & s
+                    Debug.Print "In module: " & c.Name & " -> replaced: " & S
                 End If
-                c.CodeModule.ReplaceLine i, Replace(s, findString, replaceString)
+                c.CodeModule.ReplaceLine i, Replace(S, findString, replaceString)
             End If
         Next i
     Next
@@ -437,7 +437,7 @@ End Sub
 
 Public Sub RemoveModulesWithoutLines(Optional silentMode As Boolean = True)
 Dim F As VBIDE.VBComponent
-Dim s As String
+Dim S As String
 Dim i As Long
 Dim msg As String
 Dim msgBoxResult As VbMsgBoxResult
@@ -460,15 +460,15 @@ Dim msgBoxResult As VbMsgBoxResult
                 If F.Type = vbext_ct_ClassModule Or F.Type = vbext_ct_StdModule Then
                     VBE.ActiveVBProject.VBComponents.Remove F
                 ElseIf Left(F.Name, Len("Report_")) = "Report_" Then
-                    s = Mid(F.Name, Len("Report_") + 1)
-                    DoCmd.OpenReport s, acDesign
-                    Reports(s).HasModule = False
-                    DoCmd.Close acReport, s, acSaveYes
+                    S = Mid(F.Name, Len("Report_") + 1)
+                    DoCmd.OpenReport S, acDesign
+                    Reports(S).HasModule = False
+                    DoCmd.Close acReport, S, acSaveYes
                 ElseIf Left(F.Name, Len("Form_")) = "Form_" Then
-                    s = Mid(F.Name, Len("Form_") + 1)
-                    DoCmd.OpenForm s, acDesign
-                    Forms(s).HasModule = False
-                    DoCmd.Close acForm, s, acSaveYes
+                    S = Mid(F.Name, Len("Form_") + 1)
+                    DoCmd.OpenForm S, acDesign
+                    Forms(S).HasModule = False
+                    DoCmd.Close acForm, S, acSaveYes
                 End If
             End If
         End If
@@ -486,7 +486,7 @@ End Sub
 Public Sub CommitAndPush(repositoryPath As String)
 Dim path As String
 Dim fn As String
-Dim s As String
+Dim S As String
 Dim commitMessage As String
 
     commitMessage = InputBox("Geef een omschrijving")
@@ -496,15 +496,15 @@ Dim commitMessage As String
     End If
     fn = gFso.BuildPath(repositoryPath, ".git\COMMITMESSAGE")
     omFileFunctions.WriteStringToFile fn, commitMessage
-    s = "cd '<repositoryPath>'"
-    s = s & vbCrLf & "'C:\Program Files\Git\bin\git.exe' add -A"
-    s = s & vbCrLf & "'C:\Program Files\Git\bin\git.exe' commit -F '<FilenameCommitMessage>'"
-    s = s & vbCrLf & "'C:\Program Files\Git\bin\git.exe' push"
-    s = Replace(s, "<repositoryPath>", repositoryPath)
-    s = Replace(s, "<FilenameCommitMessage>", fn)
-    s = Replace(s, "'", Chr(34))
+    S = "cd '<repositoryPath>'"
+    S = S & vbCrLf & "'C:\Program Files\Git\bin\git.exe' add -A"
+    S = S & vbCrLf & "'C:\Program Files\Git\bin\git.exe' commit -F '<FilenameCommitMessage>'"
+    S = S & vbCrLf & "'C:\Program Files\Git\bin\git.exe' push"
+    S = Replace(S, "<repositoryPath>", repositoryPath)
+    S = Replace(S, "<FilenameCommitMessage>", fn)
+    S = Replace(S, "'", Chr(34))
     fn = gFso.BuildPath(CurrentProject.path, CurrentProject.Name & "_CommitAndPush.bat")
-    omFileFunctions.WriteStringToFile fn, s
+    omFileFunctions.WriteStringToFile fn, S
     Shell fn
 End Sub
 
@@ -514,17 +514,19 @@ Dim objType As AcObjectType
 
     rs.Open "SELECT Name,Type FROM MSysobjects WHERE Name LIKE '~%'", CurrentProject.connection, adOpenForwardOnly, adLockReadOnly
     While Not rs.EOF
-
+        objType = -1
         Select Case rs("Type")
+            Case 4
+                objType = acTable
             Case 5
                 objType = acQuery
             Case -32766
                 objType = acMacro
             Case Else
                 objType = 0
-                msgbox "ObjectType Not Defined " & rs("type")
+                MsgBox "ObjectType Not Defined " & rs("type")
         End Select
-        If objType <> 0 Then
+        If objType > -1 Then
             DoCmd.DeleteObject objType, rs("Name")
         End If
         rs.MoveNext
@@ -533,11 +535,11 @@ Dim objType As AcObjectType
     Set rs = Nothing
 End Sub
 
-Public Sub ListFormsToTable()
+Public Sub ListFormsToTable(Optional tableName As String = "___T_Forms")
 Dim rs As New ADODB.Recordset
 Dim F As AccessObject
 
-    rs.Open "___T_Forms", CurrentProject.connection, adOpenForwardOnly, adLockOptimistic
+    rs.Open tableName, CurrentProject.connection, adOpenForwardOnly, adLockOptimistic
     For Each F In CodeProject.AllForms
         rs.AddNew
         rs("Name") = F.Name