VBA Macro to run RO Find Logic

Form to find ROs in Westinghouse Word Documents

PROMS/VEPROMS User Interface/MSWordVBA/VlnWROMacros.bas

@@ -0,0 +1,8 @@
+Attribute VB_Name = "VlnWROMacros"
+Sub FindWRO()
+' FindWRO Macro
+	vlnNextROForm.Show
+End Sub
+Public Sub RunAgain()
+  vlnNextROForm.btnNext2_Click
+End Sub

PROMS/VEPROMS User Interface/MSWordVBA/vlnNextROForm.frm

@@ -0,0 +1,316 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} vlnNextROForm 
+   Caption         =   "Find RO"
+   ClientHeight    =   3390
+   ClientLeft      =   45
+   ClientTop       =   345
+   ClientWidth     =   8010
+   OleObjectBlob   =   "vlnNextROForm.frx":0000
+   ShowModal       =   0   'False
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "vlnNextROForm"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+
+
+
+
+Option Explicit
+Dim ContinueProcessing As Boolean
+
+Private Function GetNextField(fld As Field) As Field
+    Dim fldNext As Field
+    On Error GoTo ehNF
+    Set fldNext = fld.Next
+    While Not fldNext Is Nothing
+        Debug.Print "fldNext " + CStr(fldNext.Index)
+        If (Mid(fldNext.Code.Text, 1, 8) = " QUOTE <") Then
+            Set GetNextField = fldNext
+            Exit Function
+        End If
+        Set fldNext = fldNext.Next
+    Wend
+    Set GetNextField = fldNext
+    Exit Function
+ehNF:
+    Set GetNextField = Nothing
+    Exit Function
+End Function
+Private Function GetPreviousField(fld As Field) As Field
+    Dim fldPrev As Field
+    On Error GoTo ehPF
+    Set fldPrev = fld.Previous
+    While Not fldPrev Is Nothing
+        Debug.Print "fldPrev " + CStr(fldPrev.Index)
+        If (Mid(fldPrev.Code.Text, 1, 8) = " QUOTE <") Then
+            Set GetPreviousField = fldPrev
+            Exit Function
+        End If
+        Set fldPrev = fldPrev.Previous
+    Wend
+    Set GetPreviousField = fldPrev
+    Exit Function
+ehPF:
+    Set GetPreviousField = Nothing
+    Exit Function
+End Function
+Private Function GetNextText(fld As Field) As String
+    Dim fldNext As Field
+    Set fldNext = GetNextField(fld)
+    If fldNext Is Nothing Then
+        GetNextText = ""
+    Else
+        GetNextText = GetRO(fldNext.Code.Text)
+    End If
+End Function
+Private Function GetPreviousText(fld As Field) As String
+    Dim fldPrev As Field
+    Set fldPrev = GetPreviousField(fld)
+    If fldPrev Is Nothing Then
+        GetPreviousText = ""
+    Else
+        GetPreviousText = GetRO(fldPrev.Code.Text)
+    End If
+End Function
+Private Sub btnNext_Click()
+'    MousePointer = fmMousePointerHourGlass
+'    DoEvents
+'    Dim rng As Range
+'    Set rng = Selection.Range
+'    Dim strt As Long
+'    strt = rng.End
+'    rng.MoveEnd wdCharacter, ActiveDocument.Characters.Count
+'    'Debug.Print str(rng.start) & " - " & str(rng.End)
+'    Dim flds As Fields
+'    Set flds = rng.Fields
+'    'Debug.Print str(flds.Count) & " Fields"
+'    Dim fld As Field
+'    For Each fld In flds
+'        Dim txt As String
+'        txt = fld.Code.Text
+'        If (fld.Code.Start > strt And Mid(fld.Code.Text, 1, 8) = " QUOTE <") Then
+'            tbNext.Text = GetNextText(fld)
+'            tbPrevious.Text = GetPreviousText(fld)
+'            Dim myType As String
+'            Dim myRO As String
+'            Dim myTxt As String
+'            myType = GetType(txt)
+'            myRO = GetRO(txt)
+'            myTxt = GetTxt(txt)
+'            If myType = "STP" Then  'setpoint
+'                ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
+'    MousePointer = fmMousePointerDefault
+'                Exit Sub
+'            ElseIf myType = "MEL" Then  'equipment
+''                If InStr(myRO, "\n") > 0 And InStr(myRO, myTxt) > 0 Then    'handle only \n for now and only if text is fullname
+'                Dim p As Integer
+'                p = InStr(myRO, "\")
+'                If p > 0 Then
+'                    Dim s As String
+'                    s = UCase(Mid(myRO, p + 1, 1))
+'                    If InStr("NRD", s) > 0 Then
+'                        ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
+'                        MousePointer = fmMousePointerDefault
+'                        Exit Sub
+'                    End If
+'                End If
+''                If InStr(myRO, "\n") > 0 Then    'handle \n name (short or full)
+''                    ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
+''    MousePointer = fmMousePointerDefault
+''                    Exit Sub
+''                End If
+''                If InStr(myRO, "\r") > 0 Then    'handle \r room
+''                    ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
+''    MousePointer = fmMousePointerDefault
+''                    Exit Sub
+''                End If
+''                If InStr(myRO, "\d") > 0 Then    'handle \d description
+''                    ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
+''    MousePointer = fmMousePointerDefault
+''                    Exit Sub
+''                End If
+'            ElseIf myType = "ARP" Then  'alarm
+'                ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
+'    MousePointer = fmMousePointerDefault
+'                Exit Sub
+'            End If
+'        End If
+'    Next
+'    tbRO.Text = ""
+'    tbText.Text = ""
+'    Beep
+'    MousePointer = fmMousePointerDefault
+End Sub
+Sub ProcessField(fld As Field, ro As String, txt As String, roPrev As String, roNext As String)
+    fld.Select
+    ActiveWindow.ScrollIntoView Selection.Range, True
+    Dim clipboard As MSForms.DataObject
+    Set clipboard = New MSForms.DataObject
+    Dim roText As String
+    If Left(ro, 4) = "<ARP" Then
+        roText = GetARPRO(ro, roPrev, roNext)
+    Else
+        roText = ro
+    End If
+    tbRO.Text = roText
+    tbText.Text = txt
+    clipboard.SetText tbRO.Text
+    clipboard.PutInClipboard
+End Sub
+Function GetARPRO(ro As String, roPrev As String, roNext As String) As String
+'<ARP CDS-LT046-MED \n\H>
+'<MEL FWS-PL-V037 \d>
+'<ARP CDS-LT046-MED \t\h\1>
+    Dim roNum As String
+    Dim roFlag As String
+    roNum = Trim(Left(ro, InStr(ro, "\") - 1))
+    roFlag = Trim(Mid(ro, InStr(ro, "\")))
+    Dim roPNum As String
+    Dim roPFlag As String
+    If roPrev = "" Then
+        roPNum = roPrev
+        roPFlag = roPrev
+    Else
+        roPNum = Trim(Left(roPrev, InStr(roPrev, "\") - 1))
+        roPFlag = Trim(Mid(roPrev, InStr(roPrev, "\")))
+    End If
+    Dim roNNum As String
+    Dim roNFlag As String
+    If roNext = "" Then
+        roNNum = roNext
+        roNFlag = roNext
+    Else
+        roNNum = Trim(Left(roNext, InStr(roNext, "\") - 1))
+        roNFlag = Trim(Mid(roNext, InStr(roNext, "\")))
+    End If
+    If InStr(ro, "\h") > 0 Or InStr(ro, "\l") > 0 Then
+        GetARPRO = roNum + GetARPExt(roFlag) + " " + roFlag
+    ElseIf roNum = roNNum And InStr(roNext, "\h") > 0 Or InStr(roNext, "\l") > 0 Then
+        GetARPRO = roNum + GetARPExt(roNFlag) + " " + roFlag
+    ElseIf roNum = roPNum And InStr(roPrev, "\h") > 0 Or InStr(roPrev, "\l") > 0 Then
+        GetARPRO = roNum + GetARPExt(roPFlag) + " " + roFlag
+    Else
+        GetARPRO = ro
+    End If
+'<ARP CDS-LT046-MED-HI1 \n\H>
+End Function
+Function GetARPExt(flg As String) As String
+    '\t\h\1
+    If InStr(flg, "\h") > 0 Then
+        GetARPExt = "-HI"
+    End If
+    If InStr(flg, "\l") > 0 Then
+        GetARPExt = "-LO"
+    End If
+    If InStr(flg, "\1") > 0 Then
+        GetARPExt = GetARPExt + "1"
+    ElseIf InStr(flg, "\2") > 0 Then
+        GetARPExt = GetARPExt + "2"
+    ElseIf InStr(flg, "\3") > 0 Then
+        GetARPExt = GetARPExt + "3"
+    End If
+End Function
+Function GetType(str As String) As String
+    Dim startpt As Integer
+    startpt = InStr(str, "<") + 1
+    GetType = Mid(str, startpt, 3)
+End Function
+Function GetRO(str As String) As String
+    Dim startpt As Integer
+    startpt = InStr(str, "<")
+    Dim endpt As Integer
+    endpt = InStr(str, ">")
+    GetRO = Mid(str, startpt, 1 + endpt - startpt)
+End Function
+Function GetTxt(txt As String) As String
+    txt = Replace(txt, Chr(30), "-")
+    Dim startpt As Integer
+    startpt = InStr(txt, ">""")
+    Dim endpt As Integer
+    endpt = InStr(txt, """<")
+    GetTxt = Mid(txt, startpt + 2, endpt - startpt - 2)
+End Function
+Sub ShowMyself()
+    vlnNextROForm.Show
+End Sub
+Public Sub btnNext2_Click()
+    ContinueProcessing = False
+    Dim fld As Field
+    Set fld = NextRO(Selection.NextField)
+    If fld Is Nothing Then
+        If ContinueProcessing Then
+            Exit Sub
+        End If
+        tbRO.Text = ""
+        tbText.Text = ""
+        Beep
+        MsgBox "No more ROs", vbOKOnly, "End of Document"
+        Exit Sub
+    End If
+    Debug.Print "btnNext2 " + CStr(fld.Index)
+    Dim txt As String
+    Dim myType As String
+    Dim myRO As String
+    Dim myTxt As String
+    txt = fld.Code.Text
+    tbNext.Text = GetNextText(fld)
+    tbPrevious.Text = GetPreviousText(fld)
+    myType = GetType(txt)
+    myRO = GetRO(txt)
+    myTxt = GetTxt(txt)
+    ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
+End Sub
+Private Function NextRO(fld As Field) As Field
+    Set NextRO = Nothing
+'topOfNextRO:
+    While Not (fld Is Nothing)
+        On Error GoTo myEH
+        If Mid(fld.Code.Text, 1, 8) = " QUOTE <" Then
+            Dim txt As String
+            Dim myType As String
+            Dim myRO As String
+            txt = fld.Code.Text
+            If tbSearch.TextLength = 0 Or InStr(txt, tbSearch.Text) > 0 Then
+                myType = GetType(txt)
+                myRO = GetRO(txt)
+                If myType = "STP" Then  'setpoint
+                    Set NextRO = fld
+                    Exit Function
+                ElseIf myType = "MEL" Then  'equipment
+                    Dim p As Integer
+                    p = InStr(myRO, "\")
+                    If p > 0 Then
+                        Dim s As String
+                        s = UCase(Mid(myRO, p + 1, 1))
+                        If InStr("NRD", s) > 0 Then
+                            Set NextRO = fld
+                            Exit Function
+                        End If
+                    End If
+                ElseIf myType = "ARP" Then  'alarm
+                   Set NextRO = fld
+                   Exit Function
+                End If
+            End If
+        End If
+        Set fld = fld.Next
+        If fld Is Nothing Then
+            Set fld = Selection.NextField
+        End If
+    Wend
+    Exit Function
+myEH:
+    ContinueProcessing = True
+    Application.OnTime DateAdd("s", 2, Now), "RunAgain"
+    Exit Function
+'    Set NextRO = NextRO(Selection.NextField)
+'    Exit Function
+'    Set fld = Selection.NextField
+'    GoTo topOfNextRO
+End Function
+Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
+    Unload Me
+End Sub