Weird excel error

[bradyboyy88]

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.

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

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

 

[Leith Ross]

Hello bradyboyy88,

When making calls to procdures in the Worksheet Open event, you need to fully qualify your references with the module name before the procdure name. For example, say that the SetIcon procedure is in Module1. Your code would then be: Call Module1.SetIcon(ThisWorkbook.Path & "\Images\LOGO.ico", 0). Do this for each procedure call in the Open event and it should work just fine.

 

[bradyboyy88]

Hello bradyboyy88,

When making calls to procdures in the Worksheet Open event, you need to fully qualify your references with the module name before the procdure name. For example, say that the SetIcon procedure is in Module1. Your code would then be: Call Module1.SetIcon(ThisWorkbook.Path & "\Images\LOGO.ico", 0). Do this for each procedure call in the Open event and it should work just fine.

How come it only does this off and on and works sometimes? Its so strange lol.

 

[bradyboyy88]

I still got the error even when i tabbed out those module references. I think it may be the getsystemmetrics function. If i get the error again I am going to tab that out as well to see if it causes it.

 

[Fluff]

In the VBE goto Tools > Options > General > select Break In Class Module > OK.
That may help in finding the problem.

 

[RoryA]

It would help to post all the API declarations. I notice that you have not declared the GetWindowLong, SetWindowLong, DrawMenuBar or FindWindowA functions as both 32 and 64 bit compatible.

 

[bradyboyy88]

I have 3 modules with API calls as shown below. I am going to try the error break idea you mentioned next time i get the error. I will say I am working under 32bit if that helps. The issue truly goes in this order. Open excel file and a few seconds later it crashes with system not responding and never even loads fully. Then I rename it so that it and dont enable macros. Then I save it . Then I will reopen and I will get the file not found error. Sounds crazy but thats typically what happens. Its a pretty big program but its on load where I get my error basically and the file not found error points to the workbook_open.

Option Explicit
Option Compare Text


'Modify window Controls
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, _
    ByVal hWnd2 As Long, _
    ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long


Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
    ByVal hWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long


Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
    ByVal HKey As Long, _
    ByVal lpSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) As Long
    
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
    ByVal HKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    LPType As Long, _
    LPData As Any, _
    lpcbData As Long) As Long


Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal HKey As Long) As Long


Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
    ByVal hWnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long


Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_CLASSES_ROOT  As Long = &H80000000
Private Const HKEY_CURRENT_CONFIG  As Long = &H80000005
Private Const HKEY_DYN_DATA  As Long = &H80000006
Private Const HKEY_PERFORMANCE_DATA  As Long = &H80000004
Private Const HKEY_USERS  As Long = &H80000003
Private Const KEY_ALL_ACCESS  As Long = &H3F
Private Const ERROR_SUCCESS  As Long = 0&
Private Const HKCU  As Long = HKEY_CURRENT_USER
Private Const HKLM  As Long = HKEY_LOCAL_MACHINE


Private Const C_USERFORM_CLASSNAME = "ThunderDFrame"
Private Const C_EXCEL_APP_CLASSNAME = "XLMain"
Private Const C_EXCEL_DESK_CLASSNAME = "XLDesk"
Private Const C_EXCEL_WINDOW_CLASSNAME = "Excel7"
Private Const MF_BYPOSITION = &H400
Private Const MF_REMOVE = &H1000
Private Const MF_ENABLED = &H0&
Private Const MF_DISABLED = &H2&
Private Const MF_GRAYED = &H1&
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_STYLE = (-16)
Private Const GWL_HWNDPARENT = (-8)
Private Const WS_CAPTION = &HC00000
Private Const WS_SYSMENU = &H80000
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2&
Private Const C_ALPHA_FULL_TRANSPARENT As Byte = 0
Private Const C_ALPHA_FULL_OPAQUE As Byte = 255
Private Const WS_DLGFRAME = &H400000
Private Const WS_THICKFRAME = &H40000
Private Const WS_SIZEBOX = WS_THICKFRAME
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000




Private Enum REG_DATA_TYPE
    REG_DATA_TYPE_DEFAULT = 0   ' Default based on data type of value.
    REG_INVALID = -1            ' Invalid
    REG_SZ = 1                  ' String
    REG_DWORD = 4               ' Long
End Enum


'--------------------------------------------------
'Mod form declarations. Some are duplicate from window caption declarations
Public Enum FORM_PARENT_WINDOW_TYPE
    FORM_PARENT_NONE = 0
    FORM_PARENT_APPLICATION = 1
    FORM_PARENT_WINDOW = 2
End Enum


Private Declare Function SetParent Lib "user32" ( _
    ByVal hWndChild As Long, _
    ByVal hWndNewParent As Long) As Long


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long) As Long


Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
    
Private Declare Function SetLayeredWindowAttributes Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal crey As Byte, _
    ByVal bAlpha As Byte, _
    ByVal dwFlags As Long) As Long


Private Declare Function GetActiveWindow Lib "user32" () As Long


Private Declare Function DrawMenuBar Lib "user32" ( _
    ByVal hWnd As Long) As Long


Private Declare Function GetMenuItemCount Lib "user32" ( _
    ByVal hMenu As Long) As Long


Private Declare Function GetSystemMenu Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal bRevert As Long) As Long
    
Private Declare Function RemoveMenu Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal nPosition As Long, _
    ByVal wFlags As Long) As Long
    
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" ( _
    ByVal hWnd As Long) As Long


Private Declare Function EnableMenuItem Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal wIDEnableItem As Long, _
    ByVal wEnable As Long) As Long
'-----------------------------------------------------
'Create Icon API , API CALLS
Private Declare Function SetWindowPos Lib "user32" _
                                      (ByVal hWnd As Long, _
                                       ByVal hWndInsertAfter As Long, _
                                       ByVal X As Long, _
                                       ByVal Y As Long, _
                                       ByVal cx As Long, _
                                       ByVal cy As Long, _
                                       ByVal wFlags As Long) As Long
                                       
Private Declare Function SendMessage Lib "user32" _
                                     Alias "SendMessageA" _
                                     (ByVal hWnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long
'Create Icon API COnstants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
                                       
'----------------------------------------------


'Clipboard API and COnstant Calls
'Handle 64-bit and 32-bit Office
#If  VBA7 Then
  Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
  Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
  Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, _
    ByVal dwBytes As LongPtr) As Long
  Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
  Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
  Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
  Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
    ByVal lpString2 As Any) As Long
  Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat _
    As LongPtr, ByVal hMem As LongPtr) As Long
#Else 
  Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
  Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
  Declare Function CloseClipboard Lib "user32" () As Long
  Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
  Declare Function EmptyClipboard Lib "user32" () As Long
  Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
    ByVal lpString2 As Any) As Long
  Declare Function SetClipboardData Lib "user32" (ByVal wFormat _
    As Long, ByVal hMem As Long) As Long
#End  If


Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
'------------------------------------
Function DoesWindowsHideFileExtensions() As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DoesWindowsHideFileExtensions
' This function looks in the registry key
'   HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced
' for the value named "HideFileExt" to determine whether the Windows Explorer
' setting "Hide Extensions Of Known File Types" is enabled. This function returns
' TRUE if this setting is in effect (meaning that Windows displays "Book1" rather
' than "Book1.xls"), or FALSE if this setting is not in effect (meaning that Windows
' displays "Book1.xls").
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim Res As Long
Dim RegKey As Long
Dim V As Long


Const KEY_NAME = "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced"
Const VALUE_NAME = "HideFileExt"


''''''''''''''''''''''''''''''''''''''''''''''''''
' Open the registry key to get a handle (RegKey).
''''''''''''''''''''''''''''''''''''''''''''''''''
Res = RegOpenKeyEx(HKey:=HKCU, _
                    lpSubKey:=KEY_NAME, _
                    ulOptions:=0&, _
                    samDesired:=KEY_ALL_ACCESS, _
                    phkResult:=RegKey)


If Res <> ERROR_SUCCESS Then
    Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the value of the "HideFileExt" named value.
''''''''''''''''''''''''''''''''''''''''''''''''''
Res = RegQueryValueEx(HKey:=RegKey, _
                    lpValueName:=VALUE_NAME, _
                    lpReserved:=0&, _
                    LPType:=REG_DWORD, _
                    LPData:=V, _
                    lpcbData:=Len(V))


If Res <> ERROR_SUCCESS Then
    RegCloseKey RegKey
    Exit Function
End If


''''''''''''''''''''''''''''''''''''''''''''''''''
' Close the key and return the result.
''''''''''''''''''''''''''''''''''''''''''''''''''
RegCloseKey RegKey
DoesWindowsHideFileExtensions = (V <> 0)




End Function




Function WindowCaption(W As Excel.Window) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WindowCaption
' This returns the Caption of the Excel.Window W with the ".xls" extension removed
' if required. The string returned by this function is suitable for use by
' the FindWindowEx API regardless of the value of the Windows "Hide Extensions"
' setting.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim HideExt As Boolean
Dim Cap As String
Dim Pos As Long


HideExt = DoesWindowsHideFileExtensions()
Cap = W.Caption
If HideExt = True Then
    Pos = InStrRev(Cap, ".")
    If Pos > 0 Then
        Cap = Left(Cap, Pos - 1)
    End If
End If


WindowCaption = Cap


End Function


Function WindowHWnd(W As Excel.Window) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WindowHWnd
' This returns the HWnd of the Window referenced by W.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim AppHWnd As Long
Dim DeskHWnd As Long
Dim WHWnd As Long
Dim Cap As String


AppHWnd = Application.hWnd
DeskHWnd = FindWindowEx(AppHWnd, 0&, C_EXCEL_DESK_CLASSNAME, vbNullString)
If DeskHWnd > 0 Then
    Cap = WindowCaption(W)
    WHWnd = FindWindowEx(DeskHWnd, 0&, C_EXCEL_WINDOW_CLASSNAME, Cap)
End If
WindowHWnd = WHWnd


End Function


Function WindowText(hWnd As Long) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WindowText
' This just wraps up GetWindowText.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim S As String
    Dim n As Long
    n = 255
    S = String$(n, vbNullChar)
    n = GetWindowText(hWnd, S, n)
    If n > 0 Then
        WindowText = Left(S, n)
    Else
        WindowText = vbNullString
    End If
End Function


Function WindowClassName(hWnd As Long) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WindowClassName
' This just wraps up GetClassName.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Dim S As String
    Dim n As Long
    n = 255
    S = String$(n, vbNullChar)
    n = GetClassName(hWnd, S, n)
    If n > 0 Then
        WindowClassName = Left(S, n)
    Else
        WindowClassName = vbNullString
    End If


End Function


'Mod window caption
Function ShowMaximizeButton(UF As MSForms.UserForm, _
    HideButton As Boolean) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShowMaximizeButton
' Displays (if HideButton is False) or hides (if HideButton is True)
' a maximize window button.
' NOTE: If EITHER a Minimize or Maximize button is displayed,
' BOTH buttons are visible but may be disabled.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    ShowMaximizeButton = False
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
If HideButton = False Then
    WinInfo = WinInfo Or WS_MAXIMIZEBOX
Else
    WinInfo = WinInfo And (Not WS_MAXIMIZEBOX)
End If
R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)


ShowMaximizeButton = (R <> 0)


End Function


Function ShowMinimizeButton(UF As MSForms.UserForm, _
    HideButton As Boolean) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShowMinimizeButton
' Displays (if HideButton is False) or hides (if HideButton is True)
' a minimize window button.
' NOTE: If EITHER a Minimize or Maximize button is displayed,
' BOTH buttons are visible but may be disabled.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    ShowMinimizeButton = False
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
If HideButton = False Then
    WinInfo = WinInfo Or WS_MINIMIZEBOX
Else
    WinInfo = WinInfo And (Not WS_MINIMIZEBOX)
End If
R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)


ShowMinimizeButton = (R <> 0)


End Function


Function HasMinimizeButton(UF As MSForms.UserForm) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' HasMinimizeButton
' Returns True if the userform has a minimize button, False
' otherwise.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    HasMinimizeButton = False
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)


If WinInfo And WS_MINIMIZEBOX Then
    HasMinimizeButton = True
Else
    HasMinimizeButton = False
End If


End Function


Function HasMaximizeButton(UF As MSForms.UserForm) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' HasMaximizeButton
' Returns True if the userform has a maximize button, False
' otherwise.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    HasMaximizeButton = False
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)


If WinInfo And WS_MAXIMIZEBOX Then
    HasMaximizeButton = True
Else
    HasMaximizeButton = False
End If


End Function




Function SetFormParent(UF As MSForms.UserForm, _
    Parent As FORM_PARENT_WINDOW_TYPE) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SetFormParent
' Set the UserForm UF as a child of (1) the Application, (2) the
' Excel ActiveWindow, or (3) no parent. Returns TRUE if successful
' or FALSE if unsuccessful.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim WindHWnd As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    SetFormParent = False
    Exit Function
End If


Select Case Parent
    Case FORM_PARENT_APPLICATION
        R = SetParent(UFHWnd, Application.hWnd)
    Case FORM_PARENT_NONE
        R = SetParent(UFHWnd, 0&)
    Case FORM_PARENT_WINDOW
        If Application.ActiveWindow Is Nothing Then
            SetFormParent = False
            Exit Function
        End If
        WindHWnd = WindowHWnd(Application.ActiveWindow)
        If WindHWnd = 0 Then
            SetFormParent = False
            Exit Function
        End If
        R = SetParent(UFHWnd, WindHWnd)
    Case Else
        SetFormParent = False
        Exit Function
End Select
SetFormParent = (R <> 0)


End Function




Function IsCloseButtonVisible(UF As MSForms.UserForm) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsCloseButtonVisible
' Returns TRUE if UserForm UF has a close button, FALSE if there
' is no close button.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    IsCloseButtonVisible = False
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
IsCloseButtonVisible = (WinInfo And WS_SYSMENU)


End Function


Function ShowCloseButton(UF As MSForms.UserForm, HideButton As Boolean) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShowCloseButton
' This displays (if HideButton is FALSE) or hides (if HideButton is
' TRUE) the Close button on the userform
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
If HideButton = False Then
    ' set the SysMenu bit
    WinInfo = WinInfo Or WS_SYSMENU
Else
    ' clear the SysMenu bit
    WinInfo = WinInfo And (Not WS_SYSMENU)
End If


R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)
ShowCloseButton = (R <> 0)


End Function




Function IsCloseButtonEnabled(UF As MSForms.UserForm) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsCloseButtonEnabled
' This returns TRUE if the close button is enabled or FALSE if
' the close button is disabled.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim hMenu As Long
Dim ItemCount As Long
Dim PrevState As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    IsCloseButtonEnabled = False
    Exit Function
End If
' Get the menu handle
hMenu = GetSystemMenu(UFHWnd, 0&)
If hMenu = 0 Then
    IsCloseButtonEnabled = False
    Exit Function
End If


ItemCount = GetMenuItemCount(hMenu)
' Disable the button. This returns MF_DISABLED or MF_ENABLED indicating
' the previous state of the item.
PrevState = EnableMenuItem(hMenu, ItemCount - 1, MF_DISABLED Or MF_BYPOSITION)


If PrevState = MF_DISABLED Then
    IsCloseButtonEnabled = False
Else
    IsCloseButtonEnabled = True
End If
' restore the previous state
EnableCloseButton UF, (PrevState = MF_DISABLED)


DrawMenuBar UFHWnd


End Function




Function EnableCloseButton(UF As MSForms.UserForm, Disable As Boolean) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' EnableCloseButton
' This function enables (if Disable is False) or disables (if
' Disable is True) the "X" button on a UserForm UF.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim hMenu As Long
Dim ItemCount As Long
Dim Res As Long


' Get the HWnd of the UserForm.
UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    EnableCloseButton = False
    Exit Function
End If
' Get the menu handle
hMenu = GetSystemMenu(UFHWnd, 0&)
If hMenu = 0 Then
    EnableCloseButton = False
    Exit Function
End If


ItemCount = GetMenuItemCount(hMenu)
If Disable = True Then
    Res = EnableMenuItem(hMenu, ItemCount - 1, MF_DISABLED Or MF_BYPOSITION)
Else
    Res = EnableMenuItem(hMenu, ItemCount - 1, MF_ENABLED Or MF_BYPOSITION)
End If
If Res = -1 Then
    EnableCloseButton = False
    Exit Function
End If
DrawMenuBar UFHWnd


EnableCloseButton = True




End Function


Function ShowTitleBar(UF As MSForms.UserForm, HideTitle As Boolean) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShowTitleBar
' Displays (if HideTitle is FALSE) or hides (if HideTitle is TRUE) the
' title bar of the userform UF.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    ShowTitleBar = False
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)


If HideTitle = False Then
    ' turn on the Caption bit
    WinInfo = WinInfo Or WS_CAPTION
Else
    ' turn off the Caption bit
    WinInfo = WinInfo And (Not WS_CAPTION)
End If
R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)
ShowTitleBar = (R <> 0)
End Function


Function IsTitleBarVisible(UF As MSForms.UserForm) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsTitleBarVisible
' Returns TRUE if the title bar of UF is visible or FALSE if the
' title bar is not visible.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    IsTitleBarVisible = False
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)


IsTitleBarVisible = (WinInfo And WS_CAPTION)


End Function


Function MakeFormResizable(UF As MSForms.UserForm, Sizable As Boolean) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MakeFormResizable
' This makes the userform UF resizable (if Sizable is TRUE) or not
' resizable (if Sizalbe is FALSE). Returns TRUE if successful or FALSE
' if an error occurred.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    MakeFormResizable = False
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
If Sizable = True Then
    WinInfo = WinInfo Or WS_SIZEBOX
Else
    WinInfo = WinInfo And (Not WS_SIZEBOX)
End If


R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)
MakeFormResizable = (R <> 0)




End Function


Function IsFormResizable(UF As MSForms.UserForm) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsFormResizable
' Returns TRUE if UF is resizable, FALSE if UF is not resizable.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim UFHWnd As Long
Dim WinInfo As Long
Dim R As Long


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    IsFormResizable = False
    Exit Function
End If


WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)


IsFormResizable = (WinInfo And WS_SIZEBOX)


End Function




Function SetFormOpacity(UF As MSForms.UserForm, Opacity As Byte) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SetFormOpacity
' This function sets the opacity of the UserForm referenced by the
' UF parameter. Opacity specifies the opacity of the form, from
' 0 = fully transparent (invisible) to 255 = fully opaque. The function
' returns True if successful or False if an error occurred. This
' requires Windows 2000 or later -- it will not work in Windows
' 95, 98, or ME.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim UFHWnd As Long
Dim WinL As Long
Dim Res As Long


SetFormOpacity = False


UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    Exit Function
End If


WinL = GetWindowLong(UFHWnd, GWL_EXSTYLE)
If WinL = 0 Then
    Exit Function
End If


Res = SetWindowLong(UFHWnd, GWL_EXSTYLE, WinL Or WS_EX_LAYERED)
If Res = 0 Then
    Exit Function
End If


Res = SetLayeredWindowAttributes(UFHWnd, 0, Opacity, LWA_ALPHA)
If Res = 0 Then
    Exit Function
End If


SetFormOpacity = True


End Function




Function HWndOfUserForm(UF As MSForms.UserForm) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' HWndOfUserForm
' This returns the window handle (HWnd) of the userform referenced
' by UF. It first looks for a top-level window, then a child
' of the Application window, then a child of the ActiveWindow.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim AppHWnd As Long
Dim DeskHWnd As Long
Dim WinHWnd As Long
Dim UFHWnd As Long
Dim Cap As String
Dim WindowCap As String


Cap = UF.Caption


' First, look in top level windows
UFHWnd = FindWindow(C_USERFORM_CLASSNAME, Cap)
If UFHWnd <> 0 Then
    HWndOfUserForm = UFHWnd
    Exit Function
End If
' Not a top level window. Search for child of application.
AppHWnd = Application.hWnd
UFHWnd = FindWindowEx(AppHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
If UFHWnd <> 0 Then
    HWndOfUserForm = UFHWnd
    Exit Function
End If
' Not a child of the application.
' Search for child of ActiveWindow (Excel's ActiveWindow, not
' Window's ActiveWindow).
If Application.ActiveWindow Is Nothing Then
    HWndOfUserForm = 0
    Exit Function
End If
WinHWnd = WindowHWnd(Application.ActiveWindow)
UFHWnd = FindWindowEx(WinHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
HWndOfUserForm = UFHWnd


End Function




Function ClearBit(value As Long, ByVal BitNumber As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ClearBit
' Clears the specified bit in Value and returns the result. Bits are
' numbered, right (most significant) 31 to left (least significant) 0.
' BitNumber is made positive and then MOD 32 to get a valid bit number.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim SetMask As Long
Dim ClearMask As Long


BitNumber = Abs(BitNumber) Mod 32


SetMask = value
If BitNumber < 30 Then
    ClearMask = Not (2 ^ (BitNumber - 1))
    ClearBit = SetMask And ClearMask
Else
    ClearBit = value And &H7FFFFFFF
End If


End Function


'CreateIconAPI
Public Sub AppTasklist(myForm)


'Add this userform into the Task bar
    Dim WStyle As Long
    Dim Result As Long
    Dim hWnd As Long
    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)


End Sub


Sub AppTaskDelist(myForm)
    'remove this userform from the Task bar
    Dim WStyle As Long
    Dim Result As Long
    Dim hWnd As Long
     
    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
    WStyle = WStyle And Not WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
    SWP_NOMOVE Or _
    SWP_NOSIZE Or _
    SWP_NOACTIVATE Or _
    SWP_HIDEWINDOW)
    Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
    SWP_NOMOVE Or _
    SWP_NOSIZE Or _
    SWP_NOACTIVATE Or _
    SWP_SHOWWINDOW)
End Sub


'Clipboard FUnctions
Function ClipBoard_SetData(MyString As String)
'PURPOSE: API function to copy text to clipboard
'SOURCE: www.msdn.microsoft.com/en-us/library/office/ff192913.aspx


Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long


'Allocate moveable global memory
  hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)


'Lock the block to get a far pointer to this memory.
  lpGlobalMemory = GlobalLock(hGlobalMemory)


'Copy the string to this global memory.
  lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)


'Unlock the memory.
  If GlobalUnlock(hGlobalMemory) <> 0 Then
    MsgBox "Could not unlock memory location. Copy aborted."
    GoTo OutOfHere2
  End If


'Open the Clipboard to copy data to.
  If OpenClipboard(0&) = 0 Then
    MsgBox "Could not open the Clipboard. Copy aborted."
    Exit Function
  End If


'Clear the Clipboard.
  X = EmptyClipboard()


'Copy the data to the Clipboard.
  hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)


OutOfHere2:
  If CloseClipboard() = 0 Then
    MsgBox "Could not close Clipboard."
  End If


End Function


Sub CopyTextToClipboard()
'PURPOSE: Copy a given text to the clipboard (using Windows API)
'SOURCE: www.TheSpreadsheetGuru.com
'NOTES: Must have above API declaration and ClipBoard_SetData function in your code


Dim txt As String


'Put some text inside a string variable
  txt = "This was copied to the clipboard using VBA!"


'Place text into the Clipboard
   ClipBoard_SetData txt


'Notify User
  MsgBox "There is now text copied to your clipboard!", vbInformation


End Sub

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

'Monitor width and height constants
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal index As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1

 

[bradyboyy88]

So i got the error again and still points straight to the workbook_open even with it set to break for class modules. If I delete everything in thisworkbook_open and hit run inside it I still get the file not found error but it doesnt highlight workbook_open just triggers that message box. This is so confusing!!

 

[RoryA]

That's a pretty large amount of code for one module. Try splitting it up over a few modules.

 

[bradyboyy88]

The one module (Userform Module) with the applications code has atleast 30x that lol. 7200 lines of code to be exact.