Weird excel error

bradyboyy88 · May 17, 2018

So I have a macro enabled workbook that when i open it it always says file not found and highlights workbook_open. But if i go to my one module and delete all the info in there and tab out a few areas of my code in the workbook_open then it will work. Then when I re add back that stuff and untab the stuff it works. Makes no sense to me lol. Here is the module and the thisworksheet module. I cannot for the life of me figure this out but I think it might have to do with one of the api's not being able to find the correct dll? Since it highlights the workbook_open and never triggers the error handler I cant figure out which file is not found.

Rich (BB code):

Option Explicit


Public Sub Workbook_Open()
    
    On Error GoTo ErrorHandler
    'Speed up vba code
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Icon Update
    'Call SetIcon(ThisWorkbook.Path & "\Images\LOGO.ico", 0) ' THis is one i tab out to fix error since routine is in module      that i delete to fix error
    
    'Seperate Instance Declaration
    Set ExcelGUIUpdates.App = Application
    
    'Delete itself from history
    Call ExcelGUIUpdates.DeleteRecentlyOpened
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'Create Regex Object string testing
    Set RegEx = CreateObject("VBScript.RegExp")
    
    'Application.DisplayAlerts = True
    
    With Userform1
        .StartUpPosition = 0
        .Left = (0.5 * GetSystemMetrics(SM_CXSCREEN)) * 0.75 - (0.5 * .Width)
        .Top = (0.5 * GetSystemMetrics(SM_CYSCREEN)) * 0.75 - (0.5 * .Height) - 10
        .Show vbModeless
    End With


'File not found error - NO clue but Resave. Then Open again then save as next version. Then save that. Then reopen and resave as something else and that one should work
Exit Sub


ErrorHandler:
Debug.Print "Error Number: " & Err.Number & ", Error Message: " & Err.Description & ", Last DLL Error: " & Err.LastDllError


End Sub


Sub Test()


Application.Quit


End Sub

Rich (BB code):

Option Explicit
'--------------------------------Create Icons Variable Declarations (API Mainly)----------------------------------'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modSetIcon
' This module contains code to change the icon of the Excel main
' window. The code is compatible with 64-bit Office.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
#If  VBA7 And Win64 Then
'''''''''''''''''''''''''''''
' 64 bit Excel
'''''''''''''''''''''''''''''
Private Declare PtrSafe Function SendMessageA Lib "user32" _
      (ByVal hWnd As LongPtr, _
      ByVal wMsg As LongPtr, _
      ByVal wParam As LongPtr, _
      ByVal lParam As LongPtr) As LongPtr


Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
      (ByVal hInst As LongPtr, _
      ByVal lpszExeFileName As String, _
      ByVal nIconIndex As LongPtr) As Long


Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Private Const WM_SETICON = &H80


#Else 
'''''''''''''''''''''''''''''
' 32 bit Excel
'''''''''''''''''''''''''''''
Private Declare Function SendMessageA Lib "user32" _
      (ByVal hWnd As Long, _
        ByVal wMsg As Long, _
        ByVal wParam As Integer, _
      ByVal lParam As Long) As Long


Private Declare Function ExtractIconA Lib "shell32.dll" _
      (ByVal hInst As Long, _
      ByVal lpszExeFileName As String, _
      ByVal nIconIndex As Long) As Long


Private Const ICON_SMALL As Long = 0&
Private Const ICON_BIG As Long = 1&
Private Const WM_SETICON As Long = &H80
#End  If


'-------------Lightbox userform windowframe removal Variable Declariations (API Mainly)----------------------------'
'All Windows API variables that must be declared via module and not class module
'Hide userform window frames. Used in class module HideTitleBar
Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" ( _
ByVal hWnd As Long) As Long
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long


'------------------------------Open file API Calls--------------------------------------------'
#If  VBA7 And Win64 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hWnd As Long, _
  ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
#Else 
Private Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hWnd As Long, _
  ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
#End  If




'--------------------------------Create Icons--------------------------------------------------'
Sub SetIcon(FileName As String, Optional index As Long = 0)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SetIcon
' This procedure sets the icon in the upper left corner of
' the main Excel window. FileName is the name of the file
' containing the icon. It may be an .ico file, an .exe file,
' or a .dll file. If it is an .ico file, Index must be 0
' or omitted. If it is an .exe or .dll file, Index is the
' 0-based index to the icon resource.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
#If  VBA7 And Win64 Then
    ' 64 bit Excel
    Dim hWnd As LongPtr
    Dim HIcon As LongPtr
#Else 
    ' 32 bit Excel
    Dim hWnd As Long
    Dim HIcon As Long
#End  If
    Dim n As Long
    Dim S As String
    If Dir(FileName, vbNormal) = vbNullString Then
        ' file not found, get out
        Exit Sub
    End If
    ' get the extension of the file.
    n = InStrRev(FileName, ".")
    S = LCase(Mid(FileName, n + 1))
    ' ensure we have a valid file type
    Select Case S
        Case "exe", "ico", "dll"
            ' OK
        Case Else
            ' invalid file type
            Err.Raise 5
    End Select
    hWnd = Application.hWnd
    If hWnd = 0 Then
        Exit Sub
    End If
    HIcon = ExtractIconA(0, FileName, index)
    If HIcon <> 0 Then
        SendMessageA hWnd, WM_SETICON, ICON_SMALL, HIcon
    End If
End Sub




'------------------------Lightbox userform windowframe removal-----------------------------'
Sub HideTitleBar(frm As Object)


    Dim lngWindow As Long
    Dim lFrmHdl As Long
    lFrmHdl = FindWindowA(vbNullString, frm.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
    
End Sub


'------------------------Allow user to return single file from filedialog-------------------------'


Function SingleFilePath()


Dim intChoice As Integer
Dim strPath As String


'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show


'determine what choice the user made
If intChoice <> 0 Then
    'get the file path selected by the user
    strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    'return the filepath
    SingleFilePath = strPath
End If


End Function


'---------------------Allow user to return multiple files from filedialog---------------------'
Function MultipleFilePath() As String()


Dim intChoice As Integer
Dim strPath() As String
Dim i As Integer


'allow the user to select multiple files
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show


'determine what choice the user made
If intChoice <> 0 Then
    'get the file path selected by the user
    For i = 1 To Application.FileDialog(msoFileDialogOpen).SelectedItems.count
        strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(i)
    Next i
End If


MultipleFilePath = strPath


End Function


'Open files command


Sub OpenFile(StringPath As String)
    If fso.GetExtensionName(StringPath) = "xls" Or fso.GetExtensionName(StringPath) = "xlsm" _
        Or fso.GetExtensionName(StringPath) = "xlsx" Then
    
        Dim xlApp As Application
        Set xlApp = CreateObject("Excel.Application")
        Application.DisplayAlerts = False
        xlApp.Workbooks.Open StringPath, , True
        Application.DisplayAlerts = True
        xlApp.Visible = True
        Set xlApp = Nothing
         
    ElseIf fso.GetExtensionName(StringPath) = "doc" Or fso.GetExtensionName(StringPath) = "pdf" _
        Or fso.GetExtensionName(StringPath) = "txt" Then
    
        Dim Result As Long
        Result = ShellExecute(0&, vbNullString, StringPath, _
        vbNullString, vbNullString, vbNormalFocus)
        If Result < 32 Then MsgBox "Error"
        
   Else
   
        Dim objShell As Object
        Set objShell = CreateObject("Shell.Application")
        Application.DisplayAlerts = False
        objShell.Open (StringPath)
        Application.DisplayAlerts = True
        Set objShell = Nothing
        
    End If
End Sub


'Copy files without waiting for file transfer to resume code
Sub FileCopyImproved(sSourceFile As String, sDestFile As String)
    
    'Asynch File Copy
    Shell Environ$("comspec") & " /c xcopy /y """ & sSourceFile & """ """ & sDestFile & "*" & """ ", vbHide
    
End Sub




Function CorrectMMCIDFormat(MMCIDEntered As String)


'Check Formatting of MMCID Entered
        If Len(MMCIDEntered) = 11 Then
            
            RegEx.Pattern = "[A-Za-z]"
            If RegEx.Test(Left(MMCIDEntered, 2)) Then
            
                RegEx.Pattern = "^[0-9]+$"
                If RegEx.Test(Right(MMCIDEntered, 8)) Then
                    
                    If Mid(MMCIDEntered, 3, 1) = "-" Then
                    
                        
                        CorrectMMCIDFormat = True
                        
                    Else
                    
                        CorrectMMCIDFormat = False
                    
                    End If
                
                Else
                    
                    CorrectMMCIDFormat = False
                
                End If
            
            Else
                
                CorrectMMCIDFormat = False
            
            End If
        
        Else
            
            CorrectMMCIDFormat = False
        
        End If


End Function


Function stripEnclosed(strIn As String) As String
'need to enable ms vbscript regular
Dim re As VBScript_RegExp_55.RegExp, AllMatches As VBScript_RegExp_55.MatchCollection, M As VBScript_RegExp_55.Match
Dim closeIndex As Long
Dim tmpstr As String
tmpstr = strIn
Set re = New VBScript_RegExp_55.RegExp
re.Global = True
re.Pattern = "<[^/>]+>"
Set AllMatches = re.Execute(tmpstr)
For Each M In AllMatches
    closeIndex = InStr(tmpstr, Replace(M.value, "<", "</"))
    If closeIndex <> 0 Then tmpstr = Left(tmpstr, InStr(tmpstr, M.value) - 1) & Mid(tmpstr, closeIndex + Len(M.value) + 1)
Next M
stripEnclosed = tmpstr
End Function


Public Function StripHTML(str As String) As String


Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
    .Global = True
    .IgnoreCase = True
    .MultiLine = True
    .Pattern = "<[^>]+>"
End With


StripHTML = RegEx.Replace(str, "")
Set RegEx = Nothing


End Function


Sub ProcessStepTracking(MMCID As Integer, SenderRole As Integer, RecipientRole As Integer, DateString As String, connectionOpen As Boolean)


    If connectionOpen Then
        DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
    End If
    
    Dim ProcessVersionTrackingVar As Integer
    Dim CurrentStep As Integer
    Dim LastStep As Integer
    Dim CurrentVersion As Integer
    Dim MaxVersionStep As Integer
    Dim MaxOrdering As Integer
    Dim IsIterative As Boolean
    Dim CurrentOrder As Integer
    Dim CurrentRound As Integer
    
    SQLQueryCode = "SELECT PRT.PROCESS_VERSION, PRT.PROCESS_STEP,PRT.ROUND, PRT.DATE_ENTERED " & _
                   "FROM (PROCESS_AND_REVIEW_TRACKING PRT INNER JOIN BASEREVIEW BR " & _
                   "ON BR.PROCESS_ORDERING_SET_DD=PRT.PROCESS_VERSION AND PRT.MMCID=BR.MMCID) " & _
                   "WHERE PRT.MMCID= " & MMCID & " ORDER BY PRT.ROUND DESC,PRT.DATE_ENTERED DESC, PRT.PROCESS_STEP DESC"


    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    LastProcessStep = ActiveRecordset.Fields("Process_Step").value
    CurrentVersion = ActiveRecordset.Fields("PROCESS_VERSION").value
    CurrentRound = ActiveRecordset.Fields("ROUND").value
    
    SQLQueryCode = "SELECT PO.MAXSTEP, PVO.ORDERING, PV.ITERABLE " & _
                   "FROM ((SELECT MAX(PROCESS_ID_NUMBER) AS MAXSTEP, PROCESS_SET_VERSION FROM Process_Ordering WHERE PROCESS_SET_VERSION=" & CurrentVersion & " GROUP BY PROCESS_SET_VERSION) AS PO INNER JOIN PROCESS_VERSION_ORDERING AS PVO ON PO.PROCESS_SET_VERSION=PVO.PROCESS_VERSION_NUMBER) " & _
                   "INNER JOIN PROCESS_VERSIONS AS PV ON PO.PROCESS_SET_VERSION=PV.VERSION_NUMBER "
    
    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    MaxVersionStep = ActiveRecordset.Fields("MAXSTEP").value
    CurrentOrder = ActiveRecordset.Fields("ORDERING").value
    IsIterative = ActiveRecordset.Fields("ITERABLE").value


    If LastProcessStep = MaxVersionStep Then
    
        If IsIterative Then
        
            SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER>0 AND PO.PROCESS_SET_VERSION=" & CurrentVersion & " ORDER BY PO.PROCESS_ID_NUMBER ASC"
            Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
            ProcessVersionTrackingVar = ActiveRecordset.Fields("PROCESS_ID_NUMBER").value
            ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
            CurrentRound = CurrentRound + 1
            
        Else
        
            SQLQueryCode = "SELECT T3.NEXT_VERSION_NUMBER, T4.PROCESS_STEP_DISPLAY_TEXT FROM (SELECT T2.PROCESS_VERSION_NUMBER AS NEXT_VERSION_NUMBER FROM ( SELECT BaseReview.MMCID, Process_Version_Ordering.ORDERING+1 AS ORDERING_PLUS_ONE, Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP, Process_Version_Ordering.PROCESS_VERSION_NUMBER FROM Process_Version_Ordering INNER JOIN BaseReview ON " & _
                            "(Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP = BaseReview.LARGER_PROCESS_VERSION_GROUP) AND (Process_Version_Ordering.PROCESS_VERSION_NUMBER = BaseReview.PROCESS_ORDERING_SET_DD) WHERE BaseReview.MMCID = " & ActiveMMCID & " ) AS T1 " & _
                            " INNER Join Process_Version_Ordering As T2 ON T1.LARGER_PROCESS_VERSION_GROUP=T2.LARGER_PROCESS_VERSION_GROUP WHERE T1.ORDERING_PLUS_ONE = T2.ORDERING ) AS T3 INNER JOIN Process_Ordering AS T4 ON T3.NEXT_VERSION_NUMBER=T4.PROCESS_SET_VERSION WHERE PROCESS_ID_NUMBER=1"


            
            Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
            If ActiveRecordset.RecordCount = 0 Then
            
                ProcessVersionTrackingVar = Null
                ProcessConfirmationMessage = ""
                
            Else
            
                'Append basereview table for new version number
                SQLQueryCode = "UPDATE BASEREVIEW" & _
                               " SET PROCESS_ORDERING_SET_DD=" & ActiveRecordset.Fields("NEXT_VERSION_NUMBER").value & _
                               " WHERE MMCID=" & ActiveMMCID
            
                Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
            
                'New version always has first step as 1
                ProcessVersionTrackingVar = 1
                CurrentRound = 1
                CurrentVersion = ActiveRecordset.Fields("PROCESS_SET_VERSION").value
                ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                    
            End If
        
        End If
    
    Else
    
        ProcessVersionTrackingVar = LastProcessStep + 1
        
        SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER=" & ProcessVersionTrackingVar & "  AND PO.PROCESS_SET_VERSION=" & CurrentVersion
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
        
    End If


    'Update Table
    If Not IsNull(ProcessVersionTrackingVar) Then
        
        'Jerry rig for fake DMCP entries for steps 9, 10, 11
        If (ProcessVersionTrackingVar = 9 Or ProcessVersionTrackingVar = 10 Or ProcessVersionTrackingVar = 11) And CurrentVersion = ProcessVersionQuestionSet Then
            SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                        " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
            Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
            ProcessVersionTrackingVar = ProcessVersionTrackingVar + 1
            SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                        " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
            Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
            ProcessVersionTrackingVar = ProcessVersionTrackingVar + 1
            SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                        " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
            Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
        Else
            SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                        " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
            Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
        End If
    End If
    
    If connectionOpen Then
        DatabaseMethods.SQLCloseDatabaseConnection
    End If
    
End Sub


Sub ProcessVersionTracking(MMCID As Integer, SenderRole As Integer, RecipientRole As Integer, DateString As String, connectionOpen As Boolean)


    If connectionOpen Then
        DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
    End If
    
    Dim ProcessVersionTrackingVar As Integer
    Dim CurrentVersion As Integer
    Dim CurrentRound As Integer
    
    SQLQueryCode = "SELECT T2.PROCESS_VERSION_NUMBER AS NEXT_VERSION_NUMBER FROM ( SELECT BaseReview.MMCID, Process_Version_Ordering.ORDERING+1 AS ORDERING_PLUS_ONE, Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP, " & _
                    " Process_Version_Ordering.PROCESS_VERSION_NUMBER FROM Process_Version_Ordering INNER JOIN BaseReview ON (Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP = BaseReview.LARGER_PROCESS_VERSION_GROUP) AND (Process_Version_Ordering.PROCESS_VERSION_NUMBER = BaseReview.PROCESS_ORDERING_SET_DD) " & _
                    " WHERE BaseReview.MMCID = " & MMCID & " ) AS T1 INNER Join Process_Version_Ordering As T2 ON T1.LARGER_PROCESS_VERSION_GROUP=T2.LARGER_PROCESS_VERSION_GROUP WHERE T1.ORDERING_PLUS_ONE = T2.ORDERING"


    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    'Assume first step in process version is always 1
    ProcessVersionTrackingVar = 1
    CurrentRound = 1
    
    'Update Table
    If ActiveRecordset.RecordCount > 0 Then
        SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                       " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & ActiveRecordset.Fields("NEXT_VERSION_NUMBER").value & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
        Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
        
        SQLQueryCode = "UPDATE BASEREVIEW SET PROCESS_ORDERING_SET_DD = " & ActiveRecordset.Fields("NEXT_VERSION_NUMBER").value & " WHERE MMCID= " & MMCID
        Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)


    End If
    
    If connectionOpen Then
        DatabaseMethods.SQLCloseDatabaseConnection
    End If
    
End Sub


Function NextStepButtonText(MMCID As Integer, SenderRole As Integer, RecipientRole As Integer, DateString As String, connectionOpen As Boolean) As String


    If connectionOpen Then
        DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
    End If
    
    Dim ProcessVersionTrackingVar As Integer
    Dim CurrentStep As Integer
    Dim LastStep As Integer
    Dim CurrentVersion As Integer
    Dim MaxVersionStep As Integer
    Dim MaxOrdering As Integer
    Dim IsIterative As Boolean
    Dim CurrentOrder As Integer
    Dim CurrentRound As Integer
    Dim ButtonText As String
    
    SQLQueryCode = "SELECT PRT.PROCESS_VERSION, PRT.PROCESS_STEP,PRT.ROUND, PRT.DATE_ENTERED " & _
                   "FROM (PROCESS_AND_REVIEW_TRACKING PRT INNER JOIN BASEREVIEW BR " & _
                   "ON BR.PROCESS_ORDERING_SET_DD=PRT.PROCESS_VERSION AND PRT.MMCID=BR.MMCID) " & _
                   "WHERE PRT.MMCID= " & MMCID & " ORDER BY PRT.DATE_ENTERED DESC, PRT.ROUND DESC, PRT.PROCESS_STEP DESC"


    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    LastProcessStep = ActiveRecordset.Fields("Process_Step").value
    CurrentVersion = ActiveRecordset.Fields("PROCESS_VERSION").value
    CurrentRound = ActiveRecordset.Fields("ROUND").value
    
    SQLQueryCode = "SELECT PO.MAXSTEP, PVO.ORDERING, PV.ITERABLE " & _
                   "FROM ((SELECT MAX(PROCESS_ID_NUMBER) AS MAXSTEP, PROCESS_SET_VERSION FROM Process_Ordering WHERE PROCESS_SET_VERSION=" & CurrentVersion & " GROUP BY PROCESS_SET_VERSION) AS PO INNER JOIN PROCESS_VERSION_ORDERING AS PVO ON PO.PROCESS_SET_VERSION=PVO.PROCESS_VERSION_NUMBER) " & _
                   "INNER JOIN PROCESS_VERSIONS AS PV ON PO.PROCESS_SET_VERSION=PV.VERSION_NUMBER "
    
    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    MaxVersionStep = ActiveRecordset.Fields("MAXSTEP").value
    CurrentOrder = ActiveRecordset.Fields("ORDERING").value
    IsIterative = ActiveRecordset.Fields("ITERABLE").value


    If LastProcessStep = MaxVersionStep Then
    
        If IsIterative Then
        
            SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT,PO.PROCESS_ACTION_BUTTON_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER>0 AND PO.PROCESS_SET_VERSION=" & CurrentVersion & " ORDER BY PO.PROCESS_ID_NUMBER ASC"
            Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
            ProcessVersionTrackingVar = ActiveRecordset.Fields("PROCESS_ID_NUMBER").value
            ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
            CurrentRound = CurrentRound + 1
            ButtonText = ActiveRecordset.Fields("PROCESS_ACTION_BUTTON_TEXT").value
            
        Else
        
            SQLQueryCode = "SELECT PROCESS_VERSION_NUMBER FROM PROCESS_VERSION_ORDERING WHERE ORDERING=" & CurrentOrder + 1
            Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
            If IsNull(ActiveRecordset.Fields("PROCESS_VERSION_NUMBER").value) Then
            
                ProcessVersionTrackingVar = Null
                ProcessConfirmationMessage = ""
                ButtonText = "Null"
            Else
            
                SQLQueryCode = "SELECT PROCESS_ID_NUMBER, PROCESS_SET_VERSION,PROCESS_STEP_DISPLAY_TEXT,PROCESS_ACTION_BUTTON_TEXT FROM PROCESS_ORDERING WHERE PROCESS_SET_VERSION=" & ActiveRecordset.Fields("PROCESS_VERSION_NUMBER").value & " AND PROCESS_ID_NUMBER>0 ORDER BY PROCESS_ID_NUMBER ASC"
                Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)


                ProcessVersionTrackingVar = ActiveRecordset.Fields("PROCESS_ID_NUMBER").value
                CurrentVersion = ActiveRecordset.Fields("PROCESS_SET_VERSION").value
                ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                ButtonText = ActiveRecordset.Fields("PROCESS_ACTION_BUTTON_TEXT").value


            End If
        
        End If
    
    Else
    
        ProcessVersionTrackingVar = LastProcessStep + 1
        
        SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT,PO.PROCESS_ACTION_BUTTON_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER=" & ProcessVersionTrackingVar & "  AND PO.PROCESS_SET_VERSION=" & CurrentVersion
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
        ButtonText = ActiveRecordset.Fields("PROCESS_ACTION_BUTTON_TEXT").value
        
    End If


    'Update Table
    NextStepButtonText = ButtonText
    
    If connectionOpen Then
        DatabaseMethods.SQLCloseDatabaseConnection
    End If
    
End Function


Function IsMaxProcessStep(MMCID As Integer, CheckIterative As Boolean, connectionOpen As Boolean)


    Dim LastStep As Integer
    Dim CurrentVersion As Integer
    Dim MaxVersionStep As Integer
    Dim CurrentOrder As Integer
    Dim IsIterative As Boolean
    
    If connectionOpen Then
        DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
    End If
    
    SQLQueryCode = "SELECT PRT.PROCESS_VERSION, PRT.PROCESS_STEP,PRT.ROUND, PRT.DATE_ENTERED " & _
                   "FROM (PROCESS_AND_REVIEW_TRACKING PRT INNER JOIN BASEREVIEW BR " & _
                   "ON BR.PROCESS_ORDERING_SET_DD=PRT.PROCESS_VERSION AND PRT.MMCID=BR.MMCID) " & _
                   "WHERE PRT.MMCID= " & MMCID & " ORDER BY PRT.DATE_ENTERED DESC, PRT.ROUND DESC, PRT.PROCESS_STEP DESC"


    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)


    LastStep = ActiveRecordset.Fields("Process_Step").value
    CurrentVersion = ActiveRecordset.Fields("PROCESS_VERSION").value
    
    SQLQueryCode = "SELECT PO.MAXSTEP, PVO.ORDERING, PV.ITERABLE " & _
                   "FROM ((SELECT MAX(PROCESS_ID_NUMBER) AS MAXSTEP, PROCESS_SET_VERSION FROM Process_Ordering WHERE PROCESS_SET_VERSION=" & CurrentVersion & " GROUP BY PROCESS_SET_VERSION) AS PO INNER JOIN PROCESS_VERSION_ORDERING AS PVO ON PO.PROCESS_SET_VERSION=PVO.PROCESS_VERSION_NUMBER) " & _
                   "INNER JOIN PROCESS_VERSIONS AS PV ON PO.PROCESS_SET_VERSION=PV.VERSION_NUMBER "
    
    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    MaxVersionStep = ActiveRecordset.Fields("MAXSTEP").value
    CurrentOrder = ActiveRecordset.Fields("ORDERING").value
    IsIterative = ActiveRecordset.Fields("ITERABLE").value
    
    If CheckIterative = True Then
        If LastStep = MaxVersionStep And IsIterative = True Then
            IsMaxProcessStep = True
        Else
            IsMaxProcessStep = False
        End If
    Else
        If LastStep = MaxVersionStep Then
            IsMaxProcessStep = True
        Else
            IsMaxProcessStep = False
        End If
    End If
    
    If connectionOpen Then
        DatabaseMethods.SQLCloseDatabaseConnection
    End If


End Function


'This is for the update of the validating documents. Since the dynamic button class cant access forms subroutines we have to put it here
Sub ActivateValidateDocs(DocumentToValidate As String)
     
    DocumentValidated = DocumentToValidate
    'Clear old Contents
    MMCARMS.ValidateDocFrame.ValidateDocBorderFrame.TypeDropDownBoxDoc.Clear


    'ACTIVATE THE SCREEN!
    With MMCARMS.MMCIDMainBlurrImage
        .Width = MMCARMS.Width
        .Height = MMCARMS.Height
        .Top = 0
        .Left = 0
        .Visible = True
        .ZOrder (0)
    End With
    
    With MMCARMS.ValidateDocFrame
        .Height = 204
        .Width = 354
        .Left = MMCARMS.MMCIDMainBlurrImage.Left + (0.5 * MMCARMS.MMCIDMainBlurrImage.Width) - (0.5 * .Width)
        .Top = MMCARMS.MMCIDMainBlurrImage.Top + (0.5 * MMCARMS.MMCIDMainBlurrImage.Height) - (0.5 * .Height) - 10
        .Visible = True
        .ZOrder (0)
    End With


    DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0


    'Find definitions to fill dropdown box
    SQLQueryCode = "SELECT DTT.DOC_TYPE_DESCRIPTION,DTT.DOC_TYPE_DD,DTT.DOC_GROUP_TYPE_DD FROM DOCUMENTATION_TYPE_TAB DTT WHERE DTT.DOC_GROUP_TYPE_DD=2 ORDER BY DTT.DOC_GROUP_TYPE_DD ASC, DTT.DOC_TYPE_DD ASC"
    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)


    DatabaseMethods.SQLCloseDatabaseConnection
    
    With MMCARMS.ValidateDocFrame.ValidateDocBorderFrame.TypeDropDownBoxDoc
        'Add item to state dropdown
        .AddItem "Select A Document Type"
    
        'Load the State into the dropdown lists as items
        While Not ActiveRecordset.EOF
            .AddItem ActiveRecordset.Fields("DOC_TYPE_DESCRIPTION").value
            ActiveRecordset.MoveNext
        Wend


        .ListIndex = 0
    End With
    
End Sub




'This for bringing up the add new policy subroutine
Sub NewCommentBoxPolicy(PolicyGrouping As Integer)


    'Clear All variables
    MMCARMS.CommentTextBox_POL.Text = ""
    MMCARMS.CommentText_POL.Caption = "Please use the textbox below to add your comment for Policy Item " & PolicyGrouping & "."
    ActivePolicyGrouping = PolicyGrouping


    With MMCARMS.MMCIDMainBlurrImage
        .Width = MMCARMS.Width
        .Height = MMCARMS.Height
        .Top = 0
        .Left = 0
        .Visible = True
        .ZOrder (0)
    End With
    
    With MMCARMS.Comment_POLFrame
        .Height = 336
        .Width = 468
        .Left = MMCARMS.MMCIDMainBlurrImage.Left + (0.5 * MMCARMS.MMCIDMainBlurrImage.Width) - (0.5 * .Width)
        .Top = MMCARMS.MMCIDMainBlurrImage.Top + (0.5 * MMCARMS.MMCIDMainBlurrImage.Height) - (0.5 * .Height)
        .Visible = True
        .ZOrder (0)
    End With
   
End Sub


Sub UpdatedResolved(PolicyGrouping As Integer)


    DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
    SQLQueryCode = "INSERT INTO POLICY_GROUP_RESOLUTION(MMCID,WHO_RESOLVED, WHEN_RESOLVED, POLICY_GROUPING,RESOLVED) " & _
                   "VALUES(" & ActiveMMCID & "," & UserNumber & ",FORMAT(#" & Now() & "#,'MM/DD/YYYY HH:mm:ss')," & PolicyGrouping & ", TRUE)"
    Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
    DatabaseMethods.SQLCloseDatabaseConnection


    MMCARMS.FillPolTab_MRP
End Sub


Public Function SortDictionaryByValue(dict As Object _
                    , Optional sortorder As XlSortOrder = xlAscending) As Object
    
    On Error GoTo eh
    
    Dim arrayList As Object
    Set arrayList = CreateObject("System.Collections.ArrayList")
    
    Dim dictTemp As Object
    Set dictTemp = CreateObject("Scripting.Dictionary")
   
    ' Put values in ArrayList and sort
    ' Store values in tempDict with their keys as a collection
    Dim key As Variant, value As Variant, coll As Collection
    For Each key In dict
    
        value = dict(key)
        
        ' if the value doesn't exist in dict then add
        If dictTemp.Exists(value) = False Then
            ' create collection to hold keys
            ' - needed for duplicate values
            Set coll = New Collection
            dictTemp.Add value, coll
            
            ' Add the value
            arrayList.Add value
            
        End If
        
        ' Add the current key to the collection
        dictTemp(value).Add key
    
    Next key
    
    ' Sort the value
    arrayList.Sort
    
    ' Reverse if descending
    If sortorder = xlDescending Then
        arrayList.Reverse
    End If
    
    dict.RemoveAll
    
    ' Read through the ArrayList and add the values and corresponding
    ' keys from the dictTemp
    Dim item As Variant
    For Each value In arrayList
        Set coll = dictTemp(value)
        For Each item In coll
            dict.Add item, value
        Next item
    Next value
    
    Set arrayList = Nothing
    
    ' Return the new dictionary
    Set SortDictionaryByValue = dict
        
Done:
    Exit Function
eh:
    If Err.Number = 450 Then
        Err.Raise vbObjectError + 100, "SortDictionaryByValue" _
                , "Cannot sort the dictionary if the value is an object"
    End If
End Function


Public Function SortDictionaryByKey(dict As Object _
                  , Optional sortorder As XlSortOrder = xlAscending) As Object
    
    Dim arrList As Object
    Set arrList = CreateObject("System.Collections.ArrayList")
    
    ' Put keys in an ArrayList
    Dim key As Variant, coll As New Collection
    For Each key In dict
        arrList.Add key
    Next key
    
    ' Sort the keys
    arrList.Sort
    
    ' For descending order, reverse
    If sortorder = xlDescending Then
        arrList.Reverse
    End If
    
    ' Create new dictionary
    Dim dictNew As Object
    Set dictNew = CreateObject("Scripting.Dictionary")
    
    ' Read through the sorted keys and add to new dictionary
    For Each key In arrList
        dictNew.Add key, dict(key)
    Next key
    
    ' Clean up
    Set arrList = Nothing
    Set dict = Nothing
    
    ' Return the new dictionary
    Set SortDictionaryByKey = dictNew
        
End Function

RoryA · May 21, 2018

Then you really need to break it up!

bradyboyy88 · May 21, 2018

Before I did this approach I researched if there were limits and I could not find any. Do you have any info on this concept?

RoryA · May 21, 2018

Ideally any module should be 64KB or less. From a practical point of view too you should split it up.

bradyboyy88 · May 21, 2018

When i export it the frx file is about 731kb and the frm file around 400kb. Is that the 64kb you are referring too?

RoryA · May 21, 2018

Yes it is.

bradyboyy88 · May 21, 2018

I will split it up and see if the error persists.

bradyboyy88 · May 22, 2018

Do you have any shortcuts for updating large amounts of code that references objects in a form module? Basically all 7000 lines use the objects directly like objectname.caption="" . There are various layers of frames so this is a HUGE update.

RoryA · May 22, 2018

I'd use a For Each loop, iterating through the controls and testing them with TypeName to see if they are what I'm interested in. For example:

Code:

For each ctl in me.controls
   if typename(ctl) = "Label" then
      ctl.caption = ""
   End if
Next ctl

bradyboyy88 · May 23, 2018

RoryA said:
I'd use a For Each loop, iterating through the controls and testing them with TypeName to see if they are what I'm interested in. For example:

Code:

For each ctl in me.controls if typename(ctl) = "Label" then ctl.caption = "" End if Next ctl

Do you know if there are size limits for the frx and frm files of the userform?

RoryA · May 23, 2018

You shouldn't really need to worry about the frx file (nothing you can do about it other than removing controls anyway). The frm file is basically the code module so the same "rule" applies. As far as I know, it's not a hard and fast rule - I've seen larger modules that have worked without issue for a long time - but it's generally safer to keep them small. My personal preference is to keep as little code in the userform as practicable.

Weird excel error

bradyboyy88

Well-known Member

RoryA

MrExcel MVP, Moderator

Excel Facts

bradyboyy88

Well-known Member

RoryA

MrExcel MVP, Moderator

bradyboyy88

Well-known Member

RoryA

MrExcel MVP, Moderator

bradyboyy88

Well-known Member

bradyboyy88

Well-known Member

RoryA

MrExcel MVP, Moderator

bradyboyy88

Well-known Member

RoryA

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Weird excel error

Well-known Member

MrExcel MVP, Moderator

Excel Facts

Well-known Member

MrExcel MVP, Moderator

Well-known Member

MrExcel MVP, Moderator

Well-known Member

Well-known Member

MrExcel MVP, Moderator

Well-known Member

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock