diff --git a/M_omFileFunctions.def b/M_omFileFunctions.def index 34182a8..3f918c3 100644 --- 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 index 258de3f..65545d0 100644 --- 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 ''" - s = s & vbCrLf & "'C:\Program Files\Git\bin\git.exe' add -A" - s = s & vbCrLf & "'C:\Program Files\Git\bin\git.exe' commit -F ''" - s = s & vbCrLf & "'C:\Program Files\Git\bin\git.exe' push" - s = Replace(s, "", repositoryPath) - s = Replace(s, "", fn) - s = Replace(s, "'", Chr(34)) + S = "cd ''" + S = S & vbCrLf & "'C:\Program Files\Git\bin\git.exe' add -A" + S = S & vbCrLf & "'C:\Program Files\Git\bin\git.exe' commit -F ''" + S = S & vbCrLf & "'C:\Program Files\Git\bin\git.exe' push" + S = Replace(S, "", repositoryPath) + S = Replace(S, "", 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