Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "signon_b2"
Attribute VB_Base = "0{AF4DA40A-9F98-4F03-9680-3C015DFE9647}{90D996D8-AA27-4A4C-A3B9-252346CCDB70}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False



'+----------------------------------------------------------------------------+
'|                             [signon_b2]
'|                            SignOn for B2
'|
'|  10/22   Bug fix in BoidCombobox_Change when BOID is blank in Options
'|  9/10    Updates for 64bit
'|  4/3     Updated to use Settings instead of Ranges
'|  1/27/20 Update for BOIDs Table
'|  5/2     get BOID returns actual correct BOID from Options tab
'|  4/30    BOID change changes "CurrentPlan" on Options tab, causing correct B2 url to select
'|  4/25    RunMode combobox does a better job remembering previous selection
'|  4/25    Forked from signon_b2_match
'|
'|  Notes: Global var "HH_Only" can set the Home/Host to a specified value
'+----------------------------------------------------------------------------+






Private Declare PtrSafe Function FindWindow _
    Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
 
Private Declare PtrSafe Function ExtractIcon _
    Lib "shell32.dll" Alias "ExtractIconA" _
   (ByVal hInst As Long, _
    ByVal lpszExeFileName As String, _
    ByVal nIconIndex As Long) As Long
 
Private Declare PtrSafe Function SendMessage _
    Lib "user32" Alias "SendMessageA" _
   (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Integer, _
    ByVal lParam As Long) As Long
 
Private Const WM_SETICON = &H80
Private DoRun As Boolean

Private Sub BOIDf_Change()
    'BoID = LCase(Left(BOIDf.Value, 2))
    boid = BOIDf.value
End Sub
Public Property Get username() As String
    username = UsernameTextbox.text
End Property
Public Property Get password() As String
    password = PasswordTextbox.text
End Property
Public Property Get runMode() As String
    runMode = RunModeCombobox.text
End Property
Public Property Get Run() As Boolean
    Run = DoRun
End Property
Public Property Let Run(ByVal running As Boolean)
    DoRun = running
    UpdateRunButton
End Property
Public Property Get boid()
    boid = Me.BoidCombobox.value
End Property
Public Property Get hostHome()
    hostHome = "Host"
    If Me.Home = True Then hostHome = "Home"
End Property

Private Sub BoidCombobox_Change()
Dim plan As String
plan = Nz(BoidCombobox.value)
PutSetting "Last Plan", plan
End Sub

Private Sub Host_Change()
    PutSetting "Last Host/Home", hostHome
End Sub


Private Sub RunButton_Click()
    On Error GoTo gotError

    If UsernameTextbox.text = "" Then Err.Raise 1, , "Username is required"
    If PasswordTextbox.text = "" Then Err.Raise 1, , "Password is required"
    If BoidCombobox.value = "" Then Err.Raise 1, , "Plan/BOID is required"
    DoRun = Not DoRun
    UpdateRunButton
    Exit Sub
gotError:
    MsgBox Err.Description, vbCritical, AppName
End Sub


Private Sub RunModeCombobox_Change()
    If RunModeCombobox.value <> "" Then PutSetting "Run Mode", RunModeCombobox.value
End Sub

Private Sub RunModeHelpButton_Click()
MsgBox "Normal - Blue2 is not visible. IE will not close without prompting you first." _
    & vbNewLine & vbNewLine & "Blue2 Visible - Blue2 visible will running. Runs slower." _
    & vbNewLine & vbNewLine & "Unattended - Blue2 is not visible. Macro can close all IE windows without warning.", vbOKOnly, AppName
End Sub

Private Sub statusBar_Change()
'i can show 56 chars
    If StatusBar.value = "" Then
        StatusBar.BackStyle = fmBackStyleTransparent
    Else
        StatusBar.BackStyle = fmBackStyleOpaque
    End If
    'If Len(statusBar.Value) > 56 Then
    '    statusBar.Value = Left(statusBar.Value, 53) & "..."
    'End If
End Sub


Private Sub UserForm_Activate()
    Me.StatusBar.text = ""
    Me.Caption = AppName
    UsernameTextbox.value = GetSetting("Last User")
    
'################    MOD for B2   #################
    BoidCombobox.value = GetSetting("Last Plan")
    If Trim(HH_Only) <> "" Then
        hostHome = LCase(HH_Only)
        Me.HostHomeLabel.enabled = False
        Me.Home.enabled = False
        Me.Host.enabled = False
    End If
    If GetSetting("Last Host/Home") = "Home" Then
        Me.Home = True
    Else
        Me.Host = True
    End If
'###################################################
    
    With RunModeCombobox
        .Clear
        .AddItem "Normal", 0
        .AddItem "Blue2 Visible"
        .AddItem "Unattended"
        .value = IIf(GetSetting("Run Mode") = "", "Normal", GetSetting("Run Mode"))
    End With

    RunButton.SetFocus
    If PasswordTextbox.value = "" Then PasswordTextbox.SetFocus
    If UsernameTextbox.value = "" Then UsernameTextbox.SetFocus
'################    MOD for B2    #################
    If BoidCombobox.value = "" Then BoidCombobox.SetFocus
'###################################################
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    On Error Resume Next
    Cancel = True
    DoRun = False
    Me.Hide
    Application.StatusBar = "Stopping. Please wait...  -  " & Application.StatusBar
End Sub

Private Sub UserForm_Terminate()
MsgBox "terminated"
DoRun = False
Application.StatusBar = "Stopping. Please wait...  -  " & Application.StatusBar
End Sub

Private Sub UsernameTextbox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    PutSetting "Last User", UsernameTextbox.text
End Sub

Private Sub UpdateRunButton()
    If DoRun <> True Then
        RunButton.Caption = "Run"
    Else
        RunButton.Caption = "Pause"
    End If
End Sub


Attribute VB_Name = "signon_basic"
Attribute VB_Base = "0{EA52D22A-C8C8-4118-9E23-26DE51F784A6}{EF657DC1-9BA4-48BD-8BA8-C52C1E23157F}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False


'+----------------------------------------------------------------------------+
'|                             [signon-basic]
'|                        No-frills sign on GUI
'|
'|  9/10    Updates for 64bit
'|  4/3     Updated to use Settings instead of Ranges
'|  4/25    RunMode combobox does a better job remembering previous selection
'|  4/24    RunMode combobox updated to default to "Normal" is no previous selection
'|  4/19    Fixed RunMode combobox. Updated setFocus order.
'|  4/13    Adjusted statusbar to hold 56 characters
'|  4/12/18 Forked from "signon" form. Removed B2 specific coding
'|
'+----------------------------------------------------------------------------+





Private Declare PtrSafe Function FindWindow _
    Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
 
Private Declare PtrSafe Function ExtractIcon _
    Lib "shell32.dll" Alias "ExtractIconA" _
   (ByVal hInst As Long, _
    ByVal lpszExeFileName As String, _
    ByVal nIconIndex As Long) As Long
 
Private Declare PtrSafe Function SendMessage _
    Lib "user32" Alias "SendMessageA" _
   (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Integer, _
    ByVal lParam As Long) As Long
 
Private Const WM_SETICON = &H80
Private DoRun As Boolean

Public Property Get username() As String
    username = UsernameTextbox.text
End Property
Public Property Get password() As String
    password = PasswordTextbox.text
End Property
Public Property Get runMode() As String
    runMode = RunModeCombobox.text
End Property
Public Property Get Run() As Boolean
    Run = DoRun
End Property
Public Property Let Run(ByVal running As Boolean)
    DoRun = running
    UpdateRunButton
End Property

Private Sub RunButton_Click()
    On Error GoTo gotError

    If UsernameTextbox.text = "" Then Err.Raise 1, , "Username is required"
    If PasswordTextbox.text = "" Then Err.Raise 1, , "Password is required"
    DoRun = Not DoRun
    UpdateRunButton
    Exit Sub
gotError:
    MsgBox Err.Description, vbCritical, AppName
End Sub


Private Sub RunModeCombobox_Change()
    If RunModeCombobox.value <> "" Then PutSetting "Run Mode", RunModeCombobox.value
End Sub

Private Sub RunModeHelpButton_Click()
MsgBox "Normal - IE is not visible. IE will not close without prompting you first." _
    & vbNewLine & vbNewLine & "IE Visible - IE visible will running. Runs slower." _
    & vbNewLine & vbNewLine & "Unattended - IE is not visible. Macro can close all IE windows without warning.", vbOKOnly, AppName
End Sub

Private Sub statusBar_Change()
'i can show 56 chars
    If StatusBar.value = "" Then
        StatusBar.BackStyle = fmBackStyleTransparent
    Else
        StatusBar.BackStyle = fmBackStyleOpaque
    End If
    'If Len(statusBar.Value) > 56 Then
    '    statusBar.Value = Left(statusBar.Value, 53) & "..."
    'End If
End Sub


Private Sub UserForm_Activate()
    Me.StatusBar.text = ""
    Me.Caption = AppName
    UsernameTextbox.value = GetSetting("Last User")

    With RunModeCombobox
        .Clear
        .AddItem "Normal", 0
        .AddItem "IE Visible"
        .AddItem "Unattended"
        .value = IIf(GetSetting("Run Mode") = "", "Normal", GetSetting("Run Mode"))
    End With
    RunButton.SetFocus
    If PasswordTextbox.value = "" Then PasswordTextbox.SetFocus
    If UsernameTextbox.value = "" Then UsernameTextbox.SetFocus
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    On Error Resume Next
    Cancel = True
    DoRun = False
    Me.Hide
    Application.StatusBar = "Stopping. Please wait...  -  " & Application.StatusBar
End Sub

Private Sub UserForm_Terminate()
MsgBox "terminated"
DoRun = False
Application.StatusBar = "Stopping. Please wait...  -  " & Application.StatusBar
End Sub

Private Sub UsernameTextbox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    PutSetting "Last User", UsernameTextbox.text
End Sub

Private Sub UpdateRunButton()
    If DoRun <> True Then
        RunButton.Caption = "Run"
    Else
        RunButton.Caption = "Pause"
    End If
End Sub

Attribute VB_Name = "signon_b2_match"
Attribute VB_Base = "0{E396C179-6179-478C-8E58-FADC14CEEEE1}{E542CF7C-2F3D-431A-B53C-8AE16A8AE0FD}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False



'+----------------------------------------------------------------------------+
'|                             [signon_b2_match]
'|                 SignOn for B2 including first/last match
'|
'|  10/26   Added DisableMatch option
'|  10/22   Bug fix in BoidCombobox_Change when BOID is blank in Options
'|  9/10    Updates for 64bit
'|  4/3     Updated to use Settings instead of Ranges
'|  1/24    Update for BOIDs Table
'|  1/6/20  Added support for "DisableOpenOnly" boolean.
'|  5/2     get BOID returns actual correct BOID from Options tab.
'|  4/30    BOID change changes "CurrentPlan" on Options tab, causing correct B2 url to select.
'|  4/25    RunMode combobox does a better job remembering previous selection.
'|  4/24    GUI remembers Host/Home on activate.
'|  4/19    Fixed RunMode combobox. Updated setFocus order.
'|  4/17/18 Reboot from old signon_match.
'|
'|  Notes: Global var "HH_Only" can set the Home/Host to a specified value.
'|  Notes: Global var "DisableOpenOnly" can be set to True to hide 'Open Only' checkbox.
'|  Notes: Global var "DisableMatch" can be set to true to hide 'Match: First/Last' options.
'+----------------------------------------------------------------------------+

Private Declare PtrSafe Function FindWindow _
    Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
 
Private Declare PtrSafe Function ExtractIcon _
    Lib "shell32.dll" Alias "ExtractIconA" _
   (ByVal hInst As Long, _
    ByVal lpszExeFileName As String, _
    ByVal nIconIndex As Long) As Long
 
Private Declare PtrSafe Function SendMessage _
    Lib "user32" Alias "SendMessageA" _
   (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Integer, _
    ByVal lParam As Long) As Long
 
Private Const WM_SETICON = &H80
Private DoRun As Boolean

Private Sub BOIDf_Change()
    'BoID = LCase(Left(BOIDf.Value, 2))
    boid = BOIDf.value
End Sub
Public Property Get username() As String
    username = UsernameTextbox.text
End Property
Public Property Get password() As String
    password = PasswordTextbox.text
End Property
Public Property Get runMode() As String
    runMode = RunModeCombobox.text
End Property
Public Property Get Run() As Boolean
    Run = DoRun
End Property
Public Property Let Run(ByVal running As Boolean)
    DoRun = running
    UpdateRunButton
End Property
Public Property Get boid()
    boid = Me.BoidCombobox.value
End Property
Public Property Get hostHome()
    hostHome = "Host"
    If Me.Home = True Then hostHome = "Home"
End Property
Public Property Get firstLast()
    firstLast = "First"
    If Me.MatchLast = True Then firstLast = "Last"
End Property
Public Property Get openOnly()
    openOnly = Me.OpenOnlyCheckbox.value
End Property


Private Sub BoidCombobox_Change()
Dim plan As String
plan = Nz(BoidCombobox.value)
PutSetting "Last Plan", plan
End Sub


Private Sub Host_Change()
    PutSetting "Last Host/Home", hostHome
End Sub


Private Sub MatchFirst_Change()
    PutSetting "Match F/L", firstLast
End Sub

Private Sub RunButton_Click()
    On Error GoTo gotError

    If UsernameTextbox.text = "" Then Err.Raise 1, , "Username is required"
    If PasswordTextbox.text = "" Then Err.Raise 1, , "Password is required"
    If BoidCombobox.value = "" Then Err.Raise 1, , "Plan/BOID is required"
    DoRun = Not DoRun
    UpdateRunButton
    Exit Sub
gotError:
    MsgBox Err.Description, vbCritical, AppName
End Sub


Private Sub RunModeCombobox_Change()
    If RunModeCombobox.value <> "" Then PutSetting "Run Mode", RunModeCombobox.value
End Sub

Private Sub RunModeHelpButton_Click()
MsgBox "Normal - Blue2 is not visible. IE will not close without prompting you first." _
    & vbNewLine & vbNewLine & "Blue2 Visible - Blue2 visible will running. Runs slower." _
    & vbNewLine & vbNewLine & "Unattended - Blue2 is not visible. Macro can close all IE windows without warning.", vbOKOnly, AppName
End Sub

Private Sub statusBar_Change()
'i can show 56 chars
    If StatusBar.value = "" Then
        StatusBar.BackStyle = fmBackStyleTransparent
    Else
        StatusBar.BackStyle = fmBackStyleOpaque
    End If
    'If Len(statusBar.Value) > 56 Then
    '    statusBar.Value = Left(statusBar.Value, 53) & "..."
    'End If
End Sub


Private Sub UserForm_Activate()
    Me.StatusBar.text = ""
    Me.Caption = AppName
    UsernameTextbox.value = GetSetting("Last User")
    
'############    MOD for B2 Match   ###############
    BoidCombobox.value = GetSetting("Last Plan")
    If Trim(HH_Only) <> "" Then
        hostHome = LCase(HH_Only)
        Me.HostHomeLabel.enabled = False
        Me.Home.enabled = False
        Me.Host.enabled = False
    End If
    If DisableOpenOnly = True Then
        OpenOnlyCheckbox.Visible = False
    End If
    If DisableMatch = True Then
        Me.MatchFirst.Visible = False
        Me.MatchLast.Visible = False
        Me.MatchLabel.Visible = False
    End If
    If GetSetting("Last Host/Home") = "Home" Then
        Me.Home = True
    Else
        Me.Host = True
    End If
    If GetSetting("Match F/L") <> "Last" Then
        Me.MatchFirst = True
    Else
        Me.MatchLast = True
    End If
'###################################################
    
    With RunModeCombobox
        .Clear
        .AddItem "Normal", 0
        .AddItem "Blue2 Visible"
        .AddItem "Unattended"
        .value = IIf(GetSetting("Run Mode") = "", "Normal", GetSetting("Run Mode"))
    End With

    RunButton.SetFocus
    If PasswordTextbox.value = "" Then PasswordTextbox.SetFocus
    If UsernameTextbox.value = "" Then UsernameTextbox.SetFocus
'############    MOD for B2 Match   ###############
    If BoidCombobox.value = "" Then BoidCombobox.SetFocus
'###################################################
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    On Error Resume Next
    Cancel = True
    DoRun = False
    Me.Hide
    Application.StatusBar = "Stopping. Please wait...  -  " & Application.StatusBar
End Sub

Private Sub UserForm_Terminate()
MsgBox "terminated"
DoRun = False
Application.StatusBar = "Stopping. Please wait...  -  " & Application.StatusBar
End Sub

Private Sub UsernameTextbox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    PutSetting "Last User", UsernameTextbox.text
End Sub

Private Sub UpdateRunButton()
    If DoRun <> True Then
        RunButton.Caption = "Run"
    Else
        RunButton.Caption = "Pause"
    End If
End Sub


Attribute VB_Name = "Excel_Functions"
'+----------------------------------------------------------------------------+
'|                             [Excel Functions]
'|                    Basic functions for Excel based macros
'|          Requires: "Microsoft Visual Basic for Applications Extensibility"
'|
'|  11/13   Updated ExportSheet to use Settings
'|  10/21   Bug fix in GetTable()
'|  10/7    Updated GetSetting and PutSetting to use GetTable & optional Workbook parameter
'|  10/6    Added GetTable() to search for table name in all sheets
'|  9/10    Updates for 64bit
'|  8/4     Updated RegExMatch to handle capture groups
'|  7/24    Added RegExMatch()
'|  4/3     Added GetSetting() & PutSetting()
'|  2/25    Added SmartCInt, SmartCLng
'|  1/24    Added VLookup to simplify using vlookup.
'|  1/2/20  Removed CountLeft(), NextCell(). Added CopyToClipboard().
'|  12/31   Moved SetListBoxValue(),SetListBoxAllNone(),& GetControlValue() here from Excel_Functions.
'|  5/29/19 Added AddReference() and DownloadURL().
'|  12/11   Added CountInStr() to count needles in a haystack.
'|  5/29    Added Clean() a clone of Excel's Clean() function.
'|  5/15    Added SmartCDate().
'|  5/4     Updated SetListBoxValue() to ignore empy values.
'|  5/3     Added Nz(),GetControlValue(),SetListBoxAllNone(),SetListBoxValue().
'|  4/19    Added AppName - needs global const "MACRO_NAME" and "VERSION".
'|  4/12    Added GUI to call the userform. (Use GUI_NAME as global const to set name).
'|  4/12/18 Removed URLDownloadToFile. Cleaned up code.
'|  3/30/16 Added header items to make functions work without other modules.
'|  5/5     Added: FileOrDirExists() & ShowFileDialog.
'|  5/4     Added: VerifySheetExists(sheetName) to verify/create sheet.
'|  1/9/15  Status() sends full text to form.
'|  6/19/14 Updated Status() to work with signon or signon_match.
'|  9/13    Updated SaveFile() to use Status().
'|  8/21    Added: Status, countLeft, statBar, nextCell, saveFile.
'|
'+----------------------------------------------------------------------------+

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Declare PtrSafe Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Public Declare PtrSafe Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Public Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
 
Public Type tagOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Function Status(StatusText As String)
    On Error Resume Next
    Dim appStatusText As String
    appStatusText = StatusText
    If InStr(StatusText, AppName) = 0 Then appStatusText = AppName & " - " & StatusText
    If StatusText = "" Then
        GUI.StatusBar.value = ""
        Application.StatusBar = False
    Else
        GUI.StatusBar.value = StatusText
        GUI.Repaint
        Application.StatusBar = appStatusText
    End If
    Status = True
End Function

Public Function statBar(percent As Double, Optional size As Integer = 40) As String
'Returns a text status/progress bar with percent complete in the middle
    Dim leftPart As String, rightPart As String, spacePart As String, activePart As String
    Dim leftSpace As Integer, rightSpace As Integer, i As Integer
    leftPart = "(."
    rightPart = ".)"
    spacePart = ".."
    activePart = "[" & Format(percent * 100, "00.00") & "%]"
    
    leftSpace = Round(percent * size, 0)
    rightSpace = size - 1 - leftSpace
    statBar = leftPart
    For i = 1 To leftSpace
        statBar = statBar & spacePart
    Next
    statBar = statBar & activePart
    For i = 1 To rightSpace
        statBar = statBar & spacePart
    Next
    statBar = statBar & rightPart
End Function


Function saveFile()
On Error GoTo gotError
    Dim PrevStatus As String
    PrevStatus = Application.StatusBar
    Status ("Saving....")
    ActiveWorkbook.Save
    Status ("Saved!")
    Sleep 1000
    Status (PrevStatus)
    saveFile = True
    Exit Function
gotError:
    saveFile = False
    Status ("Failed to Save File!")
End Function

Public Function VerifySheetExists(sheetName As String, Optional createIfNeeded As Boolean = True) As Boolean
    Dim currentSheet As Integer
    VerifySheetExists = False
    For i = 1 To ActiveWorkbook.Sheets.Count
        If ActiveWorkbook.Sheets(i).Name = sheetName Then VerifySheetExists = True
    Next
    If VerifySheetExists = False And createIfNeeded = True Then
        With ActiveWorkbook
            currentSheet = .ActiveSheet.Index
            Dim nws As Worksheet
            Set nws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            nws.Name = sheetName
            VerifySheetExists = True
            .Sheets(currentSheet).Activate
        End With
    End If
    Exit Function
gotError:
    VerifySheetExists = False
End Function


Function ShowFileDialog(ByVal SaveFileDialog As Boolean, strFilter As String, strTitle As String, ByVal strInitialDirec As String, Optional defaultFileName)
'Pass in a boolean indicating whether this is a SaveFileDialog. If false, it will be an open fileEDialog.
' Sample filter string - this one for excel files (the Chr(0) functions like the vertical bar in VB.Net filters).
'-- Dim filter As String
'-- filter = "Excel files(*.xlsx)" & Chr(0) & "*.xlsx" & Chr(0) & "All Files (*.*)" & Chr(0) & "*.*"
    On Error GoTo gotError
    Dim OFN As tagOPENFILENAME
    Dim strFileName As String, strFileTitle As String
    If IsMissing(defaultFileName) = False Then strFileName = defaultFileName
    strFileName = VBA.Left(strFileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    With OFN
        .lStructSize = Len(OFN)
        '.hwndOwner = Application.hWndAccessApp
        .strFilter = strFilter
        .nFilterIndex = 0
        .strFile = VBA.Left(strFileName & String(256, 0), 256)
        .nMaxFile = VBA.Len(strFileName)
        .strFileTitle = String(256, 0)
        .nMaxFileTitle = VBA.Len(strFileTitle)
        .strTitle = strTitle
        .Flags = 0
        .strDefExt = ""
        .strInitialDir = strInitialDirec
        .strCustomFilter = ""
        .nMaxCustFilter = 0
        .lpfnHook = 0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    If SaveFileDialog Then aht_apiGetSaveFileName OFN Else aht_apiGetOpenFileName OFN
    'The string returned is 256 chars long, ending in nulls. Remove the nulls.
    ShowFileDialog = OFN.strFile
    If VBA.Len(OFN.strFile & "") = 0 Then Exit Function
    Dim i As Long
    For i = VBA.Len(OFN.strFile) To 1 Step -1
        If VBA.Mid(OFN.strFile, i, 1) <> Constants.vbNullChar Then Exit For
    Next i
    ShowFileDialog = VBA.Mid(OFN.strFile, 1, i)
    Exit Function
gotError:
    ShowFileDialog = False
End Function

Function FileOrDirExists(PathName As String) As Boolean
'Function returns TRUE if the specified file or folder exists, false if not.
    Dim iTemp As Integer
    On Error Resume Next
    iTemp = GetAttr(PathName)
    'Check if error exists and set response appropriately
    Select Case Err.Number
    Case Is = 0
        FileOrDirExists = True
    Case Else
        FileOrDirExists = False
    End Select
End Function

Public Function ExportSheet(Optional sheetName As String) As Boolean
    ExportSheet = False
    Dim filename As String, filter As String, lastFileNameArray() As String
    Dim ws As Worksheet, newWorkbook As Workbook
    Dim lastFileName As String, newSheetName As String
    Dim lastFileDir As String, lastFileNamePart As String
    newSheetName = GetSetting("ExportSheet")
    lastFileName = GetSetting("ExportPath")
    If lastFileName <> "" Then
        lastFileName = StrReverse(lastFileName)
        lastFileNameArray = Split(lastFileName, "\", 2)
        lastFileNamePart = StrReverse(lastFileNameArray(0))
        lastFileDir = StrReverse(lastFileNameArray(1))
    End If
'get File Name
    filter = "Excel files(*.xlsx)" & Chr(0) & "*.xlsx" & Chr(0) & "All Files (*.*)" & Chr(0) & "*.*"
    filename = ShowFileDialog(True, filter, "Export File Name", lastFileDir, lastFileNamePart)
    If InStr(filename, "\") = 0 Then
        MsgBox "Export Canceled!", vbInformation, "Export Sheet"
        Exit Function
    End If
    If newSheetName = "" Then newSheetName = sheetName
    newSheetName = InputBox("New Worksheet (tab) Name." & vbNewLine & "Press Cancel to keep original.", "Export Sheet", newSheetName)
    If newSheetName = "" Then newSheetName = sheetName
    PutSetting "ExportSheet", newSheetName
    PutSetting "ExportPath", filename
'make new file
    Set ws = ActiveWorkbook.Sheets(sheetName)
    Set newWorkbook = Workbooks.Add
'copy sheet & save
    ws.Copy Before:=newWorkbook.Sheets(1)
    newWorkbook.Sheets(sheetName).Name = newSheetName
    newWorkbook.SaveAs filename
    ExportSheet = True
End Function

Public Function CopyFile(oldPathAndFile As String, newPathAndFile As String, Optional openOldPath As Boolean = False) As Boolean
    'Copies file from one location to another
    On Error GoTo gotError
    Dim oldPath As String
    oldPath = StrReverse(oldPathAndFile)
    If InStr(oldPath, "/") Then oldPath = Mid(oldPath, InStr(oldPath, "/") + 1)
    If InStr(oldPath, "\") Then oldPath = Mid(oldPath, InStr(oldPath, "\") + 1)
    oldPath = StrReverse(oldPath)
    CopyFile = False
    Dim fs As Object
    If openOldPath Then Shell "C:\WINDOWS\explorer.exe """ & oldPath & "", vbNormalFocus
    If FileOrDirExists(oldPathAndFile) = False Then
        MsgBox "Error! """ & oldPathAndFile & """ was not found", vbCritical, "Copying files.."
        Exit Function
    End If
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFile oldPathAndFile, newPathAndFile
    Set fs = Nothing
    CopyFile = True
    Exit Function
gotError:
    MsgBox "Failed copying " & oldPathAndFile & " to """ & newPathAndFile & """" & Chr(13) & Error
End Function

Public Sub KillProperly(fileToKill As String)
    If Len(Dir$(fileToKill)) > 0 Then
        SetAttr fileToKill, vbNormal
        Kill fileToKill
    End If
End Sub

Public Function AppName() As String
    AppName = MACRO_NAME & " " & VERSION
End Function

Public Function GUI(Optional formName As String = "") As Object
    'lets you call the userform as "GUI.show". Should have GUI_NAME as Global Const
    Dim i As Integer, foundForm As Boolean
    If formName = "" Then formName = GUI_NAME
    If UserForms.Count = 0 Then
        CallByName UserForms, "Add", VbMethod, formName
        Set GUI = UserForms(0)
    Else
        For i = 0 To UserForms.Count - 1
            If UserForms(i).Name = formName Then
                Set GUI = UserForms(i)
                foundForm = True
                Exit For
            End If
        Next
        If foundForm = False Then
            CallByName UserForms, "Add", VbMethod, formName
            Set GUI = UserForms(UserForms.Count - 1)
        End If
    End If
End Function

Public Function Nz(ByVal theValue As Variant, Optional nullValue As String = "") As Variant
    If IsNull(theValue) Then
        Nz = nullValue
    Else
        Nz = theValue
    End If
End Function

Public Function SmartCDate(value As Variant, Optional valueOnError As Variant = Null) As Variant
'Like CDate, only returning either NULL or a specific date on error
    On Error GoTo gotError
    If value = "" Then GoTo gotError
    SmartCDate = CDate(value)
    Exit Function
gotError:
    SmartCDate = valueOnError
End Function

Public Function SmartCInt(value As Variant, Optional valueOnError As Variant = Null) As Variant
'Like CInt, only returning either NULL or a specific int on error
    On Error GoTo gotError
    If value = "" Then GoTo gotError
    SmartCInt = CInt(value)
    Exit Function
gotError:
    SmartCInt = valueOnError
End Function

Public Function SmartCLng(value As Variant, Optional valueOnError As Variant = Null) As Variant
'Like CLng, only returning either NULL or a specific Long on error
    On Error GoTo gotError
    If value = "" Then GoTo gotError
    SmartCLng = CLng(value)
    Exit Function
gotError:
    SmartCLng = valueOnError
End Function

Public Function Clean(stringValue As String) As String
    Clean = Application.WorksheetFunction.Clean(Trim(stringValue))
End Function

Public Function CountInStr(textString As String, subStringToFind As String) As Long
    CountInStr = 0
    On Error Resume Next
    CountInStr = UBound(Split(textString, subStringToFind))
End Function

Public Function AddReference(refUrl As String)
    On Error Resume Next
    Const LPATH As String = "C:\SS_Macro\"
    Dim refName As String
    Dim VBAEditor As VBIDE.VBE
    Dim vbProj As VBIDE.VBProject
    Dim chkRef As VBIDE.Reference
    Dim BoolExists As Boolean

    Set VBAEditor = Application.VBE
    Set vbProj = ActiveWorkbook.VBProject
    
    If FileOrDirExists(LPATH) = False Then MkDir LPATH
    refName = StrReverse(refUrl)
    refName = Mid(refName, 1, InStr(refName, "/") - 1)
    refName = StrReverse(refName)
    refName = Replace(refName, ".txt", "")

    '~~> Check if "Microsoft VBScript Regular Expressions 5.5" is already added
    For Each chkRef In vbProj.References
        If chkRef.FullPath = LPATH & refName Then
            BoolExists = True
            GoTo CleanUp
        End If
    Next
    If FileOrDirExists(LPATH & refName) = False Then DownloadURL refUrl, LPATH & refName
    
    vbProj.References.AddFromFile LPATH & refName

CleanUp:
    If BoolExists = True Then
        'MsgBox "Reference already exists"
    Else
        'MsgBox "Reference Added Successfully"
    End If

    Set vbProj = Nothing
    Set VBAEditor = Nothing
End Function

Public Function DownloadURL(urlPath As String, savePath) As Boolean
    DownloadURL = False
    On Error GoTo gotError
    Dim myURL As String, WinHttpReq As Object, oStream As Object

    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", urlPath, False
    WinHttpReq.Send
    
    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile savePath, 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If
    DownloadURL = True
    Exit Function
gotError:
    MsgBox "Failed to download " & urlPath & vbNewLine & Err.Description
End Function

Public Sub CopyToClipboard(text As String)
    MsgBox "Copying to Clipboard"
    Dim clippy As New DataObject
    clippy.SetText (text)
    clippy.PutInClipboard
End Sub

Public Function VLookup(lookupValue As Variant, lookUpRange As Range, returnColumn As Integer, Optional approxMatch As Boolean = False) As Variant
    VLookup = Application.VLookup(lookupValue, lookUpRange, returnColumn, approxMatch)
End Function

Public Function GetTable(TableName As String, Optional wb As Workbook) As ListObject
    If IsEmpty(wb) Or wb Is Nothing Then Set wb = ThisWorkbook
    For Each s In wb.Sheets
        For Each t In s.ListObjects
            If t.Name = TableName Then
                Set GetTable = t
…