vB Regex Error Detection

This is a sample of "stub" code using REGEX (regular expressions) to find predefined Error words expecially when Internet Explorer unexpectedly asks for a Certificate.

    1. detect and skip  Windows Certificate Errors or similar Error page that IE may surprise the user with
    2. Fill in a Login Form
  • To WORK: it needs you to identify the (login or other) form elements
    1. identify a unique STRING in the unexpected  Error (Certificate) page
'________________________
Function checkForError(strErr,strTag)' returns 1 of 3 strings FULL LARGE INNERTEXT STRING IF ERR FOUND, ELSE "PASS"
Dim names,ele,innerText,outerText,temp,bFlag' used as string to debug
temp=""
bFlag=False' flag True if ERR FOUND, false if ERR NOT FOUND
Set names=objIE.Document.getElementsByTagName(strTag)

' sample: needs IE page object to be defined and navigated to as current page, having login form elements

'√' CHECKING for and bypassing MICROSOFT CERTIFICATE WARNING

isUnsafe=findClickOkIfUnsafe("not recommended",testLinks)
'bad string is first param signalling certificate error

If isUnsafe>=0then testLinks(isUnsafe-1).Click
' (1) works if HARD CODED FROM OBSERVATION - code returns
' (2) ??
' testLinks(isUnsafe).Click ' using index as boolean????  

call waitForReady(objIE)    ' do this after each click on menu
end If   
   ' self documenting comments by doing "find" of H4 tag or any desired flag/tag

' LEAVING MICROSOFT CERTIFICATE WARNING INTO LOG IN PAGE
'_________ functions / subroutines _________

Function findClickOkIfUnsafe(strInnerText,someArray) ' returns index if any member of someArray has "bad string"
Dim k, foundAt, strtmp

foundAt=-1
strtmp=""
'msgbox "array length: " & someArray.length , , "from Function findClickOkIfUnsafe"          ' for debugging, tells you where you are
for k = 0 to someArray.length-1    'LBound(someArray) to UBound(someArray)
If (boolRegExMatch ( someArray( k ).innerText, trim(strInnerText)) > 0)then
        'booltemp = True '( True OR booltemp)
foundAt= k
exit for
end if
next 'k

findClickOkIfUnsafe=foundAt
' if for/next never entered then returns -1 from second line

End Function

'________________________
Function boolRegExMatch(regx,strng) ' returns COUNT no it's NOT boolean!!!!
Dim regEx, Match,Matches, n, tmp ' Create variable.
Set regEx=NewRegExp ' Create a regular expression.
regEx.Pattern=regx ' Set pattern.
regEx.IgnoreCase=True ' Set case insensitivity.
regEx.Global=True ' Set global applicability.
Set Matches=regEx.Execute(strng) ' Execute search.
boolRegExMatch=Matches.count
Set Matches=Nothing
Set RegEx=Nothing
End Function

'________________________

Function checkForError(strErr,strTag)
' returns 1 of 3 strings full INNERTEXT STRING IF error found, ELSE "PASS"
Dim names,ele,innerText,outerText,temp,bFlag' used as string to debug
temp=""

bFlag=False ' flag True if ERR FOUND, false if ERR NOT FOUND
Set names=objIE.Document.getElementsByTagName(strTag)

For each ele in names
innerText=ele.innerText
If (boolRegExMatch(strErr,innerText)>0)Then
 
temp = "Fail: "&innerText' innerText

exit For   ' only reports first error found!?
Else
temp="PASS"
End If
Next
checkForError=temp
End Function
'________________________
Function fnLogin(uid,pwd)
Dim inputs,strPageStatus
Set inputs=objIE.Document.getElementsByTagName("INPUT")

inputs(2).Value=uid
inputs(3).Value=pwd
inputs(4).Click

' on Error GoTo 0
' If Err.Number then strPageStatus = "FAILERROR: CLOSE DUPLICATE BROWSER SESSION" & vbCrlf & Err.Description else
waitForReady(objIE)
strPageStatus=checkForError(".*password.*incorrect.*|Prohibite.*","DIV")'prefixes "Failed:" to InnerText
' End If
fnLogin=strPageStatus
End Function

'________________________

Function checkForError(strErr,strTag)' returns 1 of 3 strings full INNERTEXT STRING IF ERR FOUND, ELSE "PASS"
Dim names, ele, innerText, outerText, temp, bFlag  ' used as string to debug
temp=""

bFlag=False ' flag True if ERR FOUND, false if ERR NOT FOUND
Set names=objIE.Document.getElementsByTagName(strTag)

For each ele innames
innerText=ele.innerText
If (boolRegExMatch(strErr,innerText)>0)Then
'If Instr(1, innerText, strErr) Then temp="Fail: "&innerText' innerText

exit For  ' only reports first error found!?
Else
temp="PASS"
End If
Next
checkForError=temp
End Function
'________________________

Outlook – Backup Selected Items

' -- Example to demonstrate CODE of built-in Outlook *email objects* 
' -- DO NOT RUN without BACKUP and SAFETY test for your unique  environment and version
' -- requires prior creation of target email folders as CONSTANTS

Const TARGETPATH = "\My Documents\CONSTANTNAME\xEmailArchive\"

Option Explicit
'  ' SUPPLEMENT TO native AUTO ARCHIVE - saves to pre-set folder '  '  '  '  
' ───────
Sub SaveAttachmentsToFolder()
' checks selected messages with attachments
' of a specific type (here file with an "xls" extension) ' and saves them to disk. Saved files are timestamped. The user
' can choose to view the saved files in Windows Explorer.
    On Error GoTo SaveAttachmentsToFolder_err

    Dim myItem As Outlook.Inspector  ' objects from a MicSoft sample routine
    Dim myOlExp As Outlook.Explorer  
    Dim myOlSel As Outlook.Selection 

    Dim ns As NameSpace
          Set ns = GetNamespace("MAPI")
    Dim Inbox As MAPIFolder
        Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Dim SubFolder As MAPIFolder ' not used
    Dim Item As Object
    
    Dim Atmt As Attachment
    Dim FileName, strSaveToPath As String
    Dim x, i As Integer
    Dim varResponse As VbMsgBoxResult
     'below set statements were for hard coded target email folders
     'Set SubFolder = Inbox.Folders("Sales Reports") 
     ' Enter correct subfolder name.
     'Set myOlSel = Inbox.Folders("Sales Reports") 
     ' Enter correct subfolder name.
     ' For x = 1 To myOlSel.Count 'added
    
    strSaveToPath = getENV("USERPROFILE") & TARGETPATH  
    'MUST HAVE TRAILING SLASH
    'strSaveToPath = getENV("HOMEPATH") & "\My Documents\TEMP\"
    Set myItem = Application.ActiveInspector
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection

''''''''''''''
For x = 1 To myOlSel.Count
  
    'For Each Item In myOlSel.Items ''replaced by net for each
      myOlSel.Item(x).Display
        For Each Atmt In myOlSel.Item(x).Attachments
        ' strname = stripIllegalChars(myOlSel.Item(x).Subject)
        ' save if filename has "xls" extension             ' If Right(Atmt.FileName, 3) = "xls" Then
        ' This path must exist! Change folder name as necessary.
     FileName = strSaveToPath & _
       Format(myOlSel.Item(x).CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName ' & stripIllegalChars(Atmt.FileName) & ".xyz"
       '   Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
       Atmt.SaveAsFile FileName
    
        Next Atmt
     myOlSel.Item(x).Close olPromptForSave
    Next x
' Show summary message
  i = myOlSel.Count
    If i > 0 Then
        varResponse = MsgBox("I found " & i & " attached files." _
        & vbCrLf & "I have saved them into the " & strSaveToPath & "." _
        & vbCrLf & vbCrLf & "Would you like to view the files now?" _
        , vbQuestion + vbYesNo, "Finished!")
' Open Windows Explorer to display saved files if user chooses
        If varResponse = vbYes Then '
        '    Shell "Explorer.exe /e,C:\Email Attachments", vbNormalFocus
             Shell "Explorer.exe /e," & strSaveToPath, vbNormalFocus
        End If
    Else
        MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
' Clear memory
SaveAttachmentsToFolder_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle Errors
SaveAttachmentsToFolder_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & CONSTANT_FULL_NAME_and_EMAIL ' "Joe Xplsknik - joex@utestme.com" _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume SaveAttachmentsToFolder_exit
End Sub

' ───────
Sub SaveSelectedAsHTML()
    Dim myItem As Outlook.Inspector
    Dim myOlExp As Outlook.Explorer  '
    Dim myOlSel As Outlook.Selection '
    Dim objItem As Object
    Dim strname, strSaveToPath As String
    Dim x As Integer
    strSaveToPath = getENV("USERPROFILE") & "\Desktop\"
    strSaveToPath = getENV("HOMEPATH") & "\My Documents\CONSTANTNAME\xEmailArchive\"
        
    Set myItem = Application.ActiveInspector
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection
    
    If Not TypeName(myOlExp) = "Nothing" Then
'        Set objItem = myOlExp.CurrentItem
'        strname = stripIllegalChars(objItem.Subject)
        'Prompt the user for confirmation
        Dim strPrompt As String
        strPrompt = IIf(myOlSel.Count = 1, myOlSel.Count & " Selected Item", myOlSel.Count & " Selected Items")
        strPrompt = strPrompt & " will be saved to " & vbCrLf & strSaveToPath & vbCrLf & _
        "Any files with the same name will be OVERWRITTEN."
        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
            'objItem.SaveAs Environ("HOMEPATH") & "\My Documents\" & strname & ".txt", olTXT

    For x = 1 To myOlSel.Count
    On Error GoTo FileError
'  strname = stripIllegalChars(myOlSel.Item(x).Subject)
'  strname = stripIllegalChars(myOlSel.Item(x).SenderEmailAddress & myOlSel.Item(x).Subject)
    strname = stripIllegalChars(myOlSel.Item(x).SenderName)   'SenderName  SenderEmailAddress
    strname = strname & "_" & stripIllegalChars(myOlSel.Item(x).Subject)
    strname = strname & "_" & Format(myOlSel.Item(x).CreationTime, "yyyymmdd_hhnnss")
              
    'MsgTxt = MsgTxt & vbCrLf & myOlSel.Item(x).SenderName & ";"
    'objItem.SaveAs Environ("USERPROFILE") & "\Desktop\" & strname & ".txt", olTXT
 myOlSel.Item(x).Display
 myOlSel.Item(x).SaveAs strSaveToPath & strname & ".htm", olHTML 'olMSGUnicode olTXT
    'The file type to save. Can be one of the following OlSaveAsType constants:
    ' olHTML, olMSG, olRTF, olTemplate, olDoc, olTXT, olVCal, olVCard, olICal, or olMSGUnicode.
                    
 myOlSel.Item(x).Close olPromptForSave 
   ' olSave olDiscard either has no effect if NOT changed
   '  myFolder.Items(1).Display
   'Set myinspector = Application.ActiveInspector
   'Set myItem = myinspector.CurrentItem
   'myItem.Close olSave
    Next x          
    End If
    Else
        MsgBox "There is no current active Explorer."
    End If
    Exit Sub
FileError:
    MsgBox "Error: (Likely " & strSaveToPath & " does not exist!)" _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: SaveSelectedAsHTML" _
        & vbCrLf & "Error Number: " & Err.Number _
 & vbCrLf & CONSTANT_FULL_NAME_and_EMAIL & _ ' "Joe Xplsknik - joex@utestme.com" _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    'Resume 'SaveAttachmentsToFolder_exit
    
    
End Sub
' ───────
Sub SaveSelectedAsTXT()
    Dim myItem As Outlook.Inspector
    Dim myOlExp As Outlook.Explorer  '
    Dim myOlSel As Outlook.Selection '
    Dim objItem As Object
    Dim strname, strSaveToPath As String
    Dim x As Integer
    'strSaveToPath = getENV("USERPROFILE") & "\Desktop\"
    'strSaveToPath = getENV("HOMEPATH") & "\My Documents\CONSTANTNAME\xEmailArchive\"
    strSaveToPath = getENV("USERPROFILE") & "\My Documents\CONSTANTNAME\xEmailArchive\"
        
    On Error GoTo FileError

    Set myItem = Application.ActiveInspector
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection
    
    If Not TypeName(myOlExp) = "Nothing" Then
'        Set objItem = myOlExp.CurrentItem
'        strname = stripIllegalChars(objItem.Subject)
        'Prompt the user for confirmation
        Dim strPrompt As String
        strPrompt = IIf(myOlSel.Count = 1, myOlSel.Count & " Selected Item", myOlSel.Count & " Selected Items")
        strPrompt = strPrompt & " will be saved to " & vbCrLf & strSaveToPath & vbCrLf & _
        "Any files with the same name will be OVERWRITTEN."
        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
            'objItem.SaveAs Environ("HOMEPATH") & "\My Documents\" & strname & ".txt", olTXT
              
    For x = 1 To myOlSel.Count
    strname = stripIllegalChars(myOlSel.Item(x).SenderName)   'SenderName  SenderEmailAddress
    strname = strname & "_" & stripIllegalChars(myOlSel.Item(x).Subject)
    strname = strname & "_" & Format(myOlSel.Item(x).CreationTime, "yyyymmdd_hhnnss") & Int(Rnd(1) * 1000)
       'strname = stripIllegalChars(myOlSel.Item(x).Subject)
                    'MsgTxt = MsgTxt & vbCrLf & myOlSel.Item(x).SenderName & ";"
                     'objItem.SaveAs Environ("USERPROFILE") & "\Desktop\" & strname & ".txt", olTXT
                    myOlSel.Item(x).Display
                    myOlSel.Item(x).SaveAs strSaveToPath & strname & ".txt", olTXT
                    'The file type to save. Can be one of the following OlSaveAsType constants:
                    '  olHTML, olMSG, olRTF, olTemplate, olDoc, olTXT, olVCal, olVCard, olICal, or olMSGUnicode.
                    
                    myOlSel.Item(x).Close olPromptForSave  ' olSave olDiscard either has no effect if NOT changed
                     '  myFolder.Items(1).Display

           'Set myinspector = Application.ActiveInspector
           'Set myItem = myinspector.CurrentItem
           'myItem.Close olSave
                    
    Next x
           
    End If
    Else
        MsgBox "There is no current active Explorer."
    End If
    Exit Sub

FileError:
    MsgBox "Error: (Likely " & strSaveToPath & " does not exist!)" _
        & vbCrLf & "Please note the following information." _
        & vbCrLf & "Macro Name: SaveSelectedAsTXT" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & CONSTANT_FULL_NAME_and_EMAIL & _' redundant - see above
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    'Resume 'SaveAttachmentsToFolder_exit
        
    
End Sub
' ───────

Private Function getENV(strReturn As String)
  'CALLED BY ChDir getENV("userprofile") & "\Desktop\"
Dim EnvString, Indx, Msg, PathLen    ' Declare variables.
Indx = 1    ' Initialize index to 1.
For Indx = 1 To Len(Environ(Indx)) + 2
    EnvString = Environ(Indx)    ' Get environment
    If UCase(Left(EnvString, Len(strReturn))) = UCase(strReturn) Then
      getENV = Mid(EnvString, Len(strReturn) + 2)
    End If
 Next Indx 'Loop Until EnvString = ""

End Function
' ───────
Private Function stripIllegalChars(strTest As String)
Dim strTemp, testThis As String
Dim kount As Integer

strTemp = ""
strTest = Trim(strTest)
For kount = 1 To Len(strTest)
testThis = Mid(strTest, kount, 1)
If InStr(".|\/?*:<>' ", testThis) > 0 Or Asc(testThis) < 32 Or Asc(testThis) = 34 Or Asc(testThis) > 129 Then
 'strTemp = strTemp & "_"
 Else: strTemp = strTemp & Mid(strTest, kount, 1)
End If
Next kount
stripIllegalChars = IIf(Len(strTemp) < 1, "Missing_Subject" & Int(Rnd(1) * 1000), strTemp)
End Function
' ───────

Sub SetFlagIcon()
    Dim mpfInbox As Outlook.Folder
    Dim obj As Outlook.MailItem
    Dim i As Integer
    
    Set mpfInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Test")
    ' Loop all items in the Inbox\Test Folder
    For i = 1 To mpfInbox.Items.Count
        If mpfInbox.Items(i).Class = olMail Then
            Set obj = mpfInbox.Items.Item(i)
            If obj.SenderEmailAddress = "someone@example.com" Then
                'Set the yellow flag icon
                obj.FlagIcon = olYellowFlagIcon
                obj.Save
            End If
         End If
    Next
End Sub
' ───────