Powerquery multi replace

Function to replace multiple text strings based on a table with "Old" and "New" Columns. For powerquery / m

let
    multiReplace= (InputText as text,tOldNew as table)as text=> 
     let
       //Use List.Generate() to do the replacements
       DoReplacement = List.Generate(
                          ()=> [Counter=0, MyText=InputText], 
                          each [Counter]<Table.RowCount(tOldNew), 
                          each [Counter=[Counter]+1, 
                                MyText=Text.Replace(
                                         [MyText], 
                                         tOldNew[Old]{Counter}, 
                                         tOldNew[New]{Counter}
                                        )
                                ], 
                          each [MyText]),
       //Return the last item in the list that
       //List.Generate() returns
       GetLastValue = List.Last(DoReplacement)
     in
      GetLastValue
in
    multiReplace

Claimtree tool

Hopefully it's self explanatory. Don't sleep on the allowance tools, that's pretty much all I use it for nowadays. It renumbers claim and can autofill the issueclassification in IFW. Here it is.

Useful macros for examiners

First some helper functions we need

Public Function isOacs() As Boolean
      isOacs = ActiveDocument.AttachedTemplate Like "oacs*"
End Function
Public Function isOacsForm()
    isOacsForm = Left(ActiveDocument.name, 3) Like "PTO" Or Left(ActiveDocument.name, 3) Like "IFW"
End Function
Public Function hasMarkup()
    hasMarkup = (ActiveDocument.Comments.Count > 0) Or (ActiveDocument.Revisions.Count > 0)
End Function

Function FindCommandBar(name As String) As CommandBar
    For Each FindCommandBar In CommandBars
        'If Not FindCommandBar.name Is Empty Then
        If FindCommandBar.name Like name Then Exit Function
    Next FindCommandBar
    Set FindCommandBar = Nothing
End Function
Function FindCommandButton(bar As CommandBar, name As String) As CommandBarControl
    Dim combo As CommandBarComboBox
    
    For Each FindCommandButton In bar.Controls
        On Error Resume Next
        If unAmp(FindCommandButton.Caption) Like name Then Exit Function
    Next FindCommandButton
    Set FindCommandButton = Nothing
Exit Function
End Function

Working with numbers: you'll need these for the numbering rejections macros below, but they are also useful themselves.  Formatselection will turn "1 5 3 2 4" into "1-5" much like the boxes on a 326 do.  removeNumberSelection() will take the selection 1-5 and ask you what numbers to remove.  If you say "3 4" it will change it to "1-2 and 5"

Function numbers2Collection(strInput As String) As Collection
    'Dim groups As Integer
    'Dim strInput As String
    'strInput = "2 5 6,4, 10-13 and 1"
    Dim reg As New RegExp
 
    'Dim addString As String
    Dim i As Integer, c As Integer
    Dim matches As MatchCollection
    Dim m As match
    Dim allNums As String
    Dim firstLast() As String
    'Dim firstInGroup As Integer
    'Dim lastInGroup As Integer
    Dim sorted As New Collection
    reg.Global = True
    reg.Pattern = "\d+-\d+"
    Set matches = reg.Execute(strInput)
    Dim mi As Integer
    For mi = matches.Count - 1 To 0 Step -1
        Set m = matches(mi)
        allNums = ""
        firstLast = Split(m.Value, "-")
        For i = firstLast(0) To firstLast(1)
            allNums = allNums & " " & i
            
        Next i
        strInput = Left(strInput, m.FirstIndex) & allNums & Mid(strInput, m.FirstIndex + m.length + 1)
     
    Next mi
    reg.Pattern = "\d+"
    Set matches = reg.Execute(strInput)
    
    sorted.Add CInt(matches(0).Value)
    For i = 1 To matches.Count - 1
        For c = 1 To sorted.Count
            If CInt(matches(i).Value) < sorted(c) Then
                sorted.Add CInt(matches(i).Value), Before:=c
                Exit For
            ElseIf c = sorted.Count Then
                sorted.Add CInt(matches(i).Value), After:=c
                Exit For
            End If
            
        
        Next c

    Next i
    Set numbers2Collection = sorted
End Function
Function formatNumbers(strInput As String) As String
    Dim groups As Integer
    'Dim strInput As String
    'strInput = "2 5 6,4, 10-13 and 1"
    'Dim reg As New regexp
    Dim addString As String
    'Dim i As Integer
    Dim c As Integer
    'Dim matches As MatchCollection
    'Dim m As match
    'Dim allNums As String
    Dim firstLast() As String
    Dim firstInGroup As Integer
    Dim lastInGroup As Integer
    Dim sorted As Collection

    Set sorted = numbers2Collection(strInput)
    'at this point all numbers are sorted and in the collection
    c = sorted.Count
    Do Until c <= 0
        firstInGroup = sorted(c)
        lastInGroup = sorted(c)
        c = c - 1
        If c > 0 Then
            Do While firstInGroup - 1 = sorted(c)
        
                    firstInGroup = sorted(c)
                    c = c - 1
                    If c = 0 Then Exit Do
            Loop
        End If
        ' add the addstring to the total string
        If firstInGroup = lastInGroup Then addString = firstInGroup Else addString = firstInGroup & "-" & lastInGroup
        Select Case groups
            Case 0
                formatNumbers = addString

            Case 1
                formatNumbers = addString & " and " & formatNumbers
            Case Else
                formatNumbers = addString & ", " & formatNumbers
        End Select
        groups = groups + 1
                                                                                 
    Loop
Exit Function

  End Function

Sub formatSelection()
Dim list As New NumberList
list.Create Selection.Text
Selection.Text = list.toString
End Sub

Sub removeNumberSelection()
    Dim sorted As Collection
    Set sorted = numbers2Collection(Selection.Text)
    Dim strDel As String
    strDel = InputBox("What claims do you want to remove from the selection?")
    If strDel = "" Then Exit Sub
    Dim colDel As Collection
    Set colDel = numbers2Collection(strDel)
    Dim i As Integer
    Dim find As Integer
    For i = 1 To colDel.Count
        find = BinarySearchInt(sorted, colDel(i))
        If find > 0 Then sorted.Remove find
    Next i
    Dim out As String
    out = ""
    For i = 1 To sorted.Count
        out = out & " " & sorted(i)
    Next i
    Selection.Text = formatNumbers(out)
End Sub 

Function BinarySearchInt(arr As Collection, ByVal search As Integer) As Long
    Dim Index As Long
    Dim first As Long
    Dim last As Long
    Dim middle As Long
    Dim inverseOrder As Boolean
    
       
    first = 1
    last = arr.Count

    ' deduct direction of sorting
    inverseOrder = (arr(first) > arr(last))

    ' assume searches failed
    BinarySearchInt = first - 1
    
    Do
        middle = (first + last) \ 2
        If arr(middle) = search Then
            BinarySearchInt = middle
            Exit Do
        ElseIf ((arr(middle) < search) Xor inverseOrder) Then
            first = middle + 1
        Else
            last = middle - 1
        End If
    Loop Until first > last
End Function

You also need to add this class file and name it NumberList

Option Explicit
Private sorted As Collection

Public Sub Create(strInput As String)
    'Dim groups As Integer
    'Dim strInput As String
    'strInput = "2 5 6,4, 10-13 and 1"
    Dim reg As New RegExp
    'Dim addString As String
    Dim i As Integer, c As Integer
    Dim matches As MatchCollection
    Dim m As match
    Dim allNums As String
    Dim firstLast() As String
    'Dim firstInGroup As Integer
    'Dim lastInGroup As Integer
    Set sorted = New Collection
    reg.Global = True
    reg.Pattern = "\d+-\d+"
    Set matches = reg.Execute(strInput)
    For Each m In matches
        allNums = ""
        firstLast = Split(m.Value, "-")
        For i = firstLast(0) To firstLast(1)
            allNums = allNums & " " & i
            
        Next i
        strInput = Replace(strInput, m.Value, allNums)
     
    Next m
    reg.Pattern = "\d+"
    Set matches = reg.Execute(strInput)
    
    sorted.Add CInt(matches(0).Value)
    For i = 1 To matches.Count - 1
        For c = 1 To sorted.Count
            If CInt(matches(i).Value) < sorted(c) Then
                sorted.Add CInt(matches(i).Value), Before:=c
                Exit For
            ElseIf c = sorted.Count Then
                sorted.Add CInt(matches(i).Value), After:=c
                Exit For
            End If
            
        
        Next c

    Next i
  
End Sub
Function toString() As String
    Dim groups As Integer
    'Dim strInput As String
    'strInput = "2 5 6,4, 10-13 and 1"
    'Dim reg As New regexp
    Dim addString As String
    'Dim i As Integer
    Dim c As Integer
    'Dim matches As MatchCollection
    'Dim m As match
    'Dim allNums As String
    Dim firstLast() As String
    Dim firstInGroup As Integer
    Dim lastInGroup As Integer
'    Dim sorted As Collection
    Dim formatNumbers As String
   ' Set sorted = numbers2Collection(strInput)
    'at this point all numbers are sorted and in the collection
    c = sorted.Count
    Do Until c <= 0
        firstInGroup = sorted(c)
        lastInGroup = sorted(c)
        c = c - 1
        If c > 0 Then
            Do While firstInGroup - 1 = sorted(c)
        
                    firstInGroup = sorted(c)
                    c = c - 1
                    If c = 0 Then Exit Do
            Loop
        End If
        ' add the addstring to the total string
        If firstInGroup = lastInGroup Then addString = firstInGroup Else addString = firstInGroup & "-" & lastInGroup
        Select Case groups
            Case 0
                formatNumbers = addString

            Case 1
                formatNumbers = addString & " and " & formatNumbers
            Case Else
                formatNumbers = addString & ", " & formatNumbers
        End Select
        groups = groups + 1
                                                                                 
    Loop
    toString = formatNumbers
Exit Function

  End Function



Public Property Get length() As Integer
    sorted.Count
End Property

Add this macro and a button to always put your signature in the box at the bottom of an action. Also won't sign if there are still unaccepted changes

Public Sub signRightPlace()
    Dim btnSig As Office.CommandBarButton
    Set btnSig = FindCommandButton(FindCommandBar("OACS"), "eSignature")
If Not hasMarkup Then
    If Left(ActiveDocument.name, 3) Like "PTO" Or Left(ActiveDocument.name, 3) Like "IFW" Then
        btnSig.Execute
    Else
        Dim sigTable As Word.Table
        Dim endOfDoc As Range
        Set endOfDoc = ActiveDocument.Range(InStr(ActiveDocument.Range.Text, "For more information about the PAIR system, see http://pair-direct.uspto.gov"), ActiveDocument.Range.End)
        If endOfDoc.Tables.Count = 1 Then
           
        
            Set sigTable = endOfDoc.Tables(1)
            If sigTable.Rows.Count <> 1 Or sigTable.Columns.Count <> 2 Then GoTo stupid
            
        Else
            Set endOfDoc = endOfDoc.Paragraphs(1).Range
            
            Set sigTable = endOfDoc.Tables.Add(endOfDoc, 1, 2)
           
            sigTable.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
        End If
        If ActiveWindow.View = wdWebView Then ActiveWindow.View = wdPrintView
        sigTable.Cell(1, 2).Range.Select
            ActiveWindow.ScrollIntoView Selection
            btnSig.Execute
    End If
Else
    MsgBox "has markup"
End If
Exit Sub
stupid:
 MsgBox "really?"
            

End Sub

Open current application in eDan

Sub edanOpen()
    Dim fs As New FileSystemObject
    Dim f As Folder
    Set f = fs.GetFolder(ActiveDocument.Path)
    Set f = f.ParentFolder
    Dim appNo As String
    'now we've got the last three digits for network OR the whole thing
    appNo = getCurrentAppNum
    ChDrive "c"
    ChDir "C:\Program Files (x86)\eDAN"
    Debug.Print CurDir
    Shell "eDAN_API.cmd ""edan:openapp(appid=""" & appNo & """)"""
End Sub
Public Function getCurrentAppNum()
    Dim fs As New FileSystemObject
    Dim f As Folder
    Set f = fs.GetFolder(ActiveDocument.Path)
    Set f = f.ParentFolder
    If Len(f.name) = 3 Then
        getCurrentAppNum = f.ParentFolder.ParentFolder.name & f.ParentFolder.name & f.name
        
    ElseIf Len(f.name) = 8 Then
        getCurrentAppNum = f.name
    Else
        Err.Raise vbError + 2, , "can't program"
    End If
End Function

Add classy line numbers to replace OACS's broken paragraph numbering

Sub OacsNum2LineNums()
    Dim p As Paragraph
    For Each p In ActiveDocument.Paragraphs
        If p.Range.ListFormat.ListType <> wdListNoNumbering Then
            p.Range.ListFormat.RemoveNumbers
            p.Range.InsertBefore vbTab
        End If
        
    Next p
    With ActiveDocument.PageSetup.LineNumbering
        .Active = True
        .CountBy = 5
        .RestartMode = wdRestartPage
        
    End With
End Sub

Add this as well if you want to always remember to do this when you close the document, should only ask when you are working on your own OACS correspondence

Sub autoclose()
    If isOacs Then
        If Not isOacsForm Then
            If ActiveDocument.Path Like "c:\*" Then
                If ActiveDocument.PageSetup.LineNumbering.Active = False Then
                    Dim r As VbMsgBoxResult
                    r = MsgBox("No line numbers detected. Run Oacs2LineNumbers?", vbYesNo, "Close Doc")
                    If r = vbYes Then OacsNum2LineNums
                    
                    
                End If
            End If
        End If
    End If
End Sub

For making amendments, turn on track changes, make changes, and then run this macro.  The tracked changes will change to 1.121 compliant markup.

Sub amd()
    Const rule121 = 5
    Dim doc As Document
    Dim rev As Revision
    Dim tRange As Range
    
    
    Set doc = ActiveDocument
    doc.TrackRevisions = False
    For Each rev In doc.Revisions
    Select Case rev.Type
    'Only include insertions and deletions
    Case wdRevisionInsert
        rev.Range.Underline = wdUnderlineDouble
        
        rev.Range.Bold = True
        rev.Range.Font.Color = wdColorRed
        rev.accept
    Case wdRevisionDelete
        If rev.Range.Characters.Count > rule121 Then
            rev.Range.Font.StrikeThrough = True
            rev.Range.Font.Color = wdColorBlue
            rev.Reject
        Else
            Set tRange = rev.Range
            rev.Reject
            'tRange.Font.Color = wdColorBlue
            tRange.InsertAfter "]]"
            tRange.InsertBefore "[["
            tRange.Font.Color = wdColorBlue
        End If
        
    
    End Select
Next rev

    Set tRange = Nothing
    Set doc = Nothing
    Set rev = Nothing
End Sub

ok so this is still a work in progress, but I've been working on pulling numbers automatically out my actions into the statements of rejection.  updateNum() will update the numbering in hidden text at the begining of each section.  if a 102 or 103 rejection statement is right above the marker, it will bold and insert the numbers in to that statement.  You may have to go into options and make sure that hidden text is visible.  the invisible flags STARTREJ and ENDREJ will border each section.  To eliminate typos and anyother problems select an empty paragraph or a group of claims, and run surroundSelRej().  That will insert the markers.

Public Sub getNumbers()
    Call getNumbersR(Selection.Range)
End Sub

Public Sub updateNums()
    Dim p As Integer, start As Long, strList As String
    p = 1
    Dim first As Boolean, firstStart As Long
    first = True
    Do While p <= ActiveDocument.Paragraphs.Count
        
            If ActiveDocument.Paragraphs.Item(p).Range.Font.Hidden = True Then
                If ActiveDocument.Range(ActiveDocument.Paragraphs.Item(p).Range.start, ActiveDocument.Paragraphs.Item(p).Range.start + Len(startFlag)) = startFlag Then
                    start = ActiveDocument.Paragraphs.Item(p).Range.start
                    If first Then
                        firstStart = start
                        first = False
                    End If
                    Do Until ActiveDocument.Paragraphs.Item(p).Range.Font.Hidden = True And ActiveDocument.Paragraphs.Item(p).Range.Text = endFlag & vbCr
                        If p > ActiveDocument.Paragraphs.Count Then Exit Sub
                        p = p + 1
                    Loop
                    strList = strList & " " & getNumbersR(ActiveDocument.Range(start, ActiveDocument.Paragraphs.Item(p).Range.start))
                    
                End If
                
            
            End If
        
    p = p + 1: Loop
    Dim firstP As Paragraph
    p = 1
    Do While p <= ActiveDocument.Paragraphs.Count
        
            If ActiveDocument.Paragraphs.Item(p).Range.Font.Hidden = True Then
                If ActiveDocument.Range(ActiveDocument.Paragraphs.Item(p).Range.start, ActiveDocument.Paragraphs.Item(p).Range.start + Len(startFlag)) = startFlag Then
                    Set firstP = ActiveDocument.Paragraphs.Item(p)
                    GoTo first
                End If
                
            
            End If
        
    p = p + 1: Loop
    Err.Raise vbError + 2, , "StartRej not found"
    Exit Sub
first:
    

    If firstP.Previous.Range.Font.Hidden = True And firstP.Previous.Range.Text Like allFlag & "*" & vbCr Then
        firstP.Previous.Range.Text = allFlag & " " & formatNumbers(strList) & vbCr
    Else
        firstP.Range.InsertBefore (allFlag & " " & formatNumbers(strList) & vbCr)
    End If
    
End Sub

Public Function getNumbersR(r As Range) As String
'takes a selection
    Dim p As Paragraph
    Dim i As Integer
    Dim nums As String
    nums = ""
    On Error GoTo ErrorHandler
    ActiveDocument.ActiveWindow.View.ShowFirstLineOnly = False
'    If Not Selection.Words(1) Like "Regarding " Then
'        MsgBox "Error"
'        Exit Sub
'    End If
'    For Each p In Selection.Paragraphs
'        If p.Range.Words(1) Like "Regarding " Then
'            i = 7
'            Do While (Asc(p.Range.Words(i).Characters(1)) >= Asc("0")) And (Asc(p.Range.Words(i).Characters(1)) <= Asc("9"))
'                nums = nums & p.Range.Words(i).Text & " "
'            i = i + 2
'            Loop
'        End If
'    Next p
    Dim reg As RegExp
    Dim mMatch As match
    
    Set reg = New RegExp
    reg.Global = True
    reg.MultiLine = True
    reg.IgnoreCase = True
    reg.Pattern = "^(\t)*Regarding (?:(?:in)?dependent )?claim(?:s|(?:\(s\)))? ((?:\d+[-\s,]*)+)( and [\d-]+)?,"
    For Each mMatch In reg.Execute(r.Text)
        nums = nums & " " & mMatch.SubMatches(0) & mMatch.SubMatches(1) & mMatch.SubMatches(2)
    Next mMatch
    reg.Pattern = "Claim([s\s\?]*(?:[-,\*\d\s]|and)+\s*(?:is|are)*)\s*rejected"
    'ActiveDocument.ActiveWindow.View.ShowFirstLineOnly = True
    'ActiveWindow.ScrollIntoView r.Characters(1), True
    Dim list As New NumberList
    list.Create nums
    Dim strList As String
    strList = list.toString
    Dim matches As MatchCollection
    Dim fpPara As Word.Range
    Set fpPara = r.Paragraphs(1).Previous.Range
    If fpPara.Text Like allFlag & "*" & vbCr And fpPara.Font.Hidden = True Then
        Set fpPara = fpPara.Previous(WdUnits.wdParagraph)
    End If
    Set matches = reg.Execute(fpPara.Text)
    Dim one As Boolean
    reg.Pattern = "\D"
    one = Not reg.test(strList)
    If matches.Count = 1 Then
    'add to fp
        fpPara.SetRange fpPara.start + InStr(fpPara.Text, matches(0).SubMatches(0)) - 1, fpPara.start + InStr(fpPara.Text, "rejected") - 1
        fpPara.Text = IIf(one, " ", "s ") & strList & IIf(one, " is ", " are ")
        fpPara.Paragraphs(1).Range.Bold = True
        If ActiveDocument.Range(r.start, r.start + Len(startFlag)) = startFlag Then
            r.Paragraphs(1).Range.Text = startFlag & " " & strList & vbCr
        End If
    Else
        If ActiveDocument.Range(r.start, r.start + Len(startFlag)) = startFlag Then
            r.Paragraphs(1).Range.Text = startFlag & " " & strList & vbCr
            Else
            r.InsertParagraphBefore
            'Selection.InsertBefore formatNumbers(nums) & " "
            
            r.InsertBefore strList & " "
        End If
    End If
    getNumbersR = strList
    Exit Function
ErrorHandler:
    If Err.Number = 6028 Then
       
        fpPara.Fields(1).Delete
       
        Err.Clear
        Resume
    End If
    If Err.Number = 4605 Then Resume Next Else MsgBox Err.Description
    
    Resume
End Function
Public Sub surroundSelRej()
    Dim r As Range
    Set r = Selection.Range
    r.Paragraphs(1).Range.InsertBefore (startFlag & vbCr)
    r.InsertAfter (vbCr & vbCr)
    With r.Paragraphs(1).Range
        .Text = startFlag & vbCr
        .Font.Hidden = True
    End With
    
    With r.Paragraphs(r.Paragraphs.Count - 1).Range
        .Text = endFlag & vbCr
        .Font.Hidden = True
    End With
    
        
End Sub
Public Sub getNumbersRej()
'takes a selection
    Dim p As Paragraph
    Dim i As Integer
    Dim nums As String
    nums = ""
    On Error GoTo ErrorHandler
    ActiveDocument.ActiveWindow.View.ShowFirstLineOnly = False
'    If Not Selection.Words(1) Like "Regarding " Then
'        MsgBox "Error"
'        Exit Sub
'    End If
'    For Each p In Selection.Paragraphs
'        If p.Range.Words(1) Like "Regarding " Then
'            i = 7
'            Do While (Asc(p.Range.Words(i).Characters(1)) >= Asc("0")) And (Asc(p.Range.Words(i).Characters(1)) <= Asc("9"))
'                nums = nums & p.Range.Words(i).Text & " "
'            i = i + 2
'            Loop
'        End If
'    Next p
    Dim reg As RegExp
    Dim mMatch As match
    
    Set reg = New RegExp
    reg.Global = True
    reg.MultiLine = True
    reg.IgnoreCase = False
    reg.Pattern = "Claim[s\s]*((?:[-,\d\s]|and)+)\s*(?:is|are)*\s*rejected"
    For Each mMatch In reg.Execute(Selection.Range.Text)
        nums = nums & " " & mMatch.SubMatches(0)
    Next mMatch
'    Selection.InsertParagraphBefore
'    Selection.InsertBefore formatNumbers(nums) & " "
'        ActiveDocument.ActiveWindow.View.ShowFirstLineOnly = True
'        ActiveWindow.ScrollIntoView Selection, True
    Dim r As VbMsgBoxResult
    Dim result As String
    result = formatNumbers(nums)
    r = MsgBox(result, vbOKCancel + vbQuestion, "Copy to Clipboard?")
    If r = vbOK Then
        Dim d As New MSForms.DataObject
        d.SetText result
        d.PutInClipboard
    End If
        
        
    Exit Sub
ErrorHandler:

    If Err.Number = 4605 Then Resume Next Else MsgBox Err.Description
    Resume
End Sub

Copy table rows from the IDS tab in edan (ctrl+s) and run this to paste in a list of IDS dates

Sub IDSfromEdan()
    Const dataPattern = "(\d{2}/){2}\d{4}(?=\t)"
    Dim reg As VBScript_RegExp_55.RegExp
    Dim matches As MatchCollection
    Dim data As DataObject
    Dim regI As Integer
    Dim strIDS As String
    Set reg = New RegExp
    Set data = New DataObject
    reg.Global = True
    reg.Pattern = dataPattern
    data.GetFromClipboard
    Set matches = reg.Execute(data.GetText)
    For regI = matches.Count - 2 To 0 Step -2
        strIDS = strIDS & matches(regI) & ", "
    Next regI
    strIDS = Left(strIDS, IIf(Len(strIDS) < 2, 0, Len(strIDS) - 2))
    If matches.Count > 1 Then strIDS = Left(strIDS, InStrRev(strIDS, ", ")) & Replace(strIDS, ", ", " and ", InStrRev(strIDS, ", "))
    Selection = strIDS

End Sub

Not sure how well this or the previous macro will work if your columns are setup differently then mine, but copy a whole row of a patent in the list of results in EAST and run this to paste in a nicely formatted patent number, name and date.

    Const patentPattern = "[\s^](US (?:(\d{11})|(\d{7,8})) \w\d*)[\s$]"
    Const patenteePattern = "[\t^]([-\w]+)[,;](?:(?:[^\t]*?( et al\.))|(?:[^\t]*?[\t$]))"
    Const datePattern = "[\s^](\d{4})(\d\d)(\d\d)[\s$]"
    Dim reg As New VBScript_RegExp_55.RegExp
    'Set reg = CreateObject("VBScript_RegExp_55.regexp")
    Dim results  As MatchCollection
    Dim result  As VBScript_RegExp_55.match
    Dim data As DataObject
    Dim east As String
    Dim patent As String
    Dim patentee As String
    Dim pubDate As String
    Set data = New DataObject
    On Error GoTo leave
    data.GetFromClipboard
    east = data.GetText
    reg.Pattern = patentPattern
    reg.Global = False
    Set result = reg.Execute(east).Item(0)
    'patent = result.SubMatches(0)
    If result.SubMatches(1) = Empty Then
    'patent
        patent = Format(result.SubMatches(2), "standard")
        patent = Left(patent, Len(patent) - 3)
        patent = Replace(result.SubMatches(0), result.SubMatches(2), patent)
    Else 'pgpub
        patent = Left(result.SubMatches(1), 4) & "/" & Mid(result.SubMatches(1), 5)
        patent = Replace(result.SubMatches(0), result.SubMatches(1), patent)
    End If
    reg.Pattern = patenteePattern
    reg.Global = False
'    Set results = reg.Execute(east)
'    If results.Count = 2 Then
'        If results(0).Length < results(1).Length Then Set result = results(0) Else Set result = results(1)
'    Else
'        Set result = results.Item(0)
'
'    End If
    Set result = reg.Execute(east).Item(0)
    patentee = result.SubMatches(0) & result.SubMatches(1)
    patent = Replace(patent, " ", Chr(160))
    reg.Pattern = datePattern
    reg.Global = False
    Set result = reg.Execute(east).Item(0)
    pubDate = result.SubMatches(1) & "/" & result.SubMatches(2) & "/" & result.SubMatches(0)
    Selection = patentee & " (" & patent & ", " & pubDate & ")"
    Selection.MoveRight
leave:
End Sub

this will turn on all the buttons in oacs in the event they are all disabled for no reason, I don't think this will work the buttons in the ribbon, but the old command bar still exists on the Developer ribbon

Public Sub reenableOacsbuttons()
    Dim c As Object
    For Each c In FindCommandBar("OACS").Controls
        c.Enabled = True
    Next c
End Sub

Put the right obviousness tatement in the rejection

Public Function isPreAIA()
    isPreAIA = InStr(ActiveDocument.Range.Text, "The present application is being examined under the pre-AIA first to invent provisions") > 0
End Function
Public Function isAIA()
    isAIA = InStr(ActiveDocument.Range.Text, "The present application, filed on or after March 16, 2013, is being examined under the first inventor to file provisions of the AIA") > 0
End Function
Public Sub ItWouldHave()
    Dim aia As Boolean, preaia As Boolean
    aia = isAIA
    preaia = isPreAIA
    Dim res As VbMsgBoxResult
    If (aia And preaia) Or (Not aia And Not preaia) Then
        res = MsgBox("Is case AIA?", vbYesNoCancel, "It would have...")
        If res = vbYes Then
            aia = True
            preaia = False
        ElseIf res = vbNo Then
            preaia = True
            aia = False
        ElseIf res = vbCancel Then
            Exit Sub
        Else
            Err.Raise vbError + 1, , "I can't program"
        End If
    End If
    Dim txt As String
    If aia Then txt = "It would have been obvious to one of ordinary skill in the art before the effective filing date of the claimed invention to"
    If preaia Then txt = "It would have been obvious to one of ordinary skill in the art at the time of the invention to"
    Selection.InsertAfter txt
    Selection.Collapse WdCollapseDirection.wdCollapseEnd
End Sub

Lock Pinned Tabs

Here's the way I use my web browsers.  I pin google calendar and gmail.  But I don't ever want to close them or navigate away.  Tab Mix Plus is great for this, for firefox, but it's a bit of a hog.  Firefox also has the setting to always open typed URLs in a new window, which would really solve all the problems for me, but I'm currently migrating to Chrome, and Chrome doesn't have the option.  I was looking into writing my own extension to do that, but I really didn't want to go down that rabbit hole.  First I'd have to learn it.  Plus, I wasn't really sure it was feasible.  For my usage, which is two pinned tabs, I had a better idea.  It's not ideal, but I made a bookmarklet that will "lock" page .  I think this only really works because of how google's apps navigate within their own window, but it works for my use case.

Lock Page

WRITE_SECURE_SETTINGS on kitkat 4.4

I recently updated my android to a Kitkat rom, and to my dismay, my car dock app, Car Dock Home v3 no longer turned on my GPS. It only brought up the location settings page, and also didn't turn it off when undocking.  Apparently this is by design (see below). Now that author has a separate app that manages car dock settings, but I think he baked most features from that into the dock app.  ,From the settings app page:

Check GPS Enabled – If the GPS is not enabled upon docking, try to enable it in the secure settings, if that doesn’t work, show the user the Location & Security settings screen.

 I thought at first secure settings meant the Xposed module, but no it means the way android firmware apps (i.e. system apps) do it which is to use the permission WRITE_SECURE_SETTINGS and do something in the API (I didn't look in to how).  The point is that non-system apps can't acquire this permission.  So the app should have worked fine if I made it a system app.  I never even noticed this becuase

There is also a known exploit to enable GPS using the back end of the power controls widget. I’ve taken advantage of that in the latest releases of this app. It will eventually fail when Google patches it up. The above ‘system app’ technique should still work in that event.

So I guess this was patched, but alas, moving it to the /system/app didn't help.  The solution was to put it in the new poorly documented /system/priv_app folder. Apparently, apps that previously needed to be converted to system apps to get some permission, now need to be in that folder. 

Hopefully this helps someone else get a previously working app functioning.

Outlook to Ical and google

So I'm trying to make it so that my wife can see my calendar which I use at work.  This was more difficult then I thought.  Biggest problem was the work computer.  Second was Microsoft and/or Google's messed up ical implementations.  The automated publish options didn't work for me because i couldn't do the whole calendar, and publishing to CalDav didn't work, probably because of the proxy firewall.  I could publish to Office but then you can only really see it with Outlook, and I wanted to use google. 

Ok so as far as problems normal people might have, they involve the ical file.  For extra joy, Google doesn't tell you what the problem is.  Since I only got it to work once the this validator passed my file, I assume Google also uses ical4j.  Microsoft's main problem was that when publishing events with a timezone, my timezone didn't have a label (e.g. GMT, EST EDT).  Even after giving it one in settings it wouldn't export the timezone with an TZID identifier.  It just said "TZID:".  Interestingly this didn't cause the error, it was when the parser tried to read a time stamp that looked like "TZID=:20130101000000" (rather than "TZID=timezone:2013...").  Having no characters between the = and : caused the parser to pick up a null rather than an empty string, so I didn't even get friendly error messages to help me figure this out.  The other problem is how Microsoft wraps long lines.  ical files have to be a certain line width.  lines are terminated with CRLF and then the next line starts with one space or a tab.  MS uses tabs.  Both the validator and google didn't like this, but AFAIK MS is correct in doing that.  Running the file through simple search and replaces fixed these problems.


The next big question was where to put this file.  My work computer is locked down and the proxy blocks most file storage sites.  Windows 7 doesn't come with Web Folders.  These can refer to the WebDAV folders or the frontpoint server extension version.  Comcast which I used to use, uses only FPSE web folders.  FTP upload was blocked (mostly, more on that later).  Because of this I'd been using MS SkyDrive for online files.  But both that and Google Drive don't give you direct dl links, so GCal wouldn't be able to parse it. 

Icalx.com looked promising, I think I got a simple HTTP PUT to upload the file a couple of times with a firefox extension.   But doing it from my own program was another story.  I have a lot of trouble automating the web through my work proxy.  The only way I usually have success is to use the IE browser itself through MS Internet Controls  (SHDocVw and ieframe.dll).  Especially when I need to authenticate site and the proxy, I just can't do it.  WinHTTP, MSXML, WebRequest, it just never works, especially if it's anything other than a GET.  So FTP is blocked from uploading, but on Windows firewall.  So if the program has access already, you can do it.  ftp.exe... blocked, the only thing that had access was IE.  And the only way I could figure out how to upload was with the FTP Explorer view.  After trying Scripting.FileSystemObject, I realized there was another COM library, shell32, Shell Automation.  Most of the documentation for this is about using the shell to zip and unzip files, but you can use for http also.  There are a few quirks.  The best of which is that none of the flags for CopyHere work.   Which means no overwriting files, no hiding progress bars.  And CopyHere is asyncronous but with no way to get progress or block.  Now windows firewall only blocks some ftp commands.  So I could use FTPWebRequest to delete the file, without authentication problems, and also use it to check the modification date on the file to see when the upload was done. 

Not very pretty or efficient, but it finally works.  Hopefully she looks at it.


See what I did

Simple way to save Password in a settings file.

 /// <summary>
 /// Description of Settings.
 /// </summary>
 public class Settings:ApplicationSettingsBase
 {
  private static Settings defaultInstance = ((Settings)(ApplicationSettingsBase.Synchronized(new Settings())));
  
  public static Settings Default {
   get {
    return defaultInstance;
   }
  }
  
  public Settings():base()
  {
  }
  
  [UserScopedSettingAttribute()]
  [DefaultSettingValueAttribute("false")]
  public bool PASS_SET {
   get { return (bool)this["PASS_SET"]; }
   private set { this["PASS_SET"] = value; }
  }
  
  [UserScopedSettingAttribute()]
  [DefaultSettingValueAttribute("")]
  /// <summary>
  /// <returns> null if !PASS_SET</returns>
  /// </summary>
  public string Password {
   get {
    return (PASS_SET)?ToInsecureString(DecryptString(this["Password"].ToString())):null;}
   set { this["Password"] = EncryptString(ToSecureString(value)); PASS_SET=true; }
  }
  static byte[] entropy = System.Text.Encoding.Unicode.GetBytes("Bumblebee Tuna, I can see your balls!");

  public static string EncryptString(System.Security.SecureString input)
  {
   byte[] encryptedData = System.Security.Cryptography.ProtectedData.Protect(
    System.Text.Encoding.Unicode.GetBytes(ToInsecureString(input)),
    entropy,
    System.Security.Cryptography.DataProtectionScope.CurrentUser);
   return Convert.ToBase64String(encryptedData);
  }

  public static SecureString DecryptString(string encryptedData)
  {
   try
   {
    byte[] decryptedData = System.Security.Cryptography.ProtectedData.Unprotect(
     Convert.FromBase64String(encryptedData),
     entropy,
     System.Security.Cryptography.DataProtectionScope.CurrentUser);
    return ToSecureString(System.Text.Encoding.Unicode.GetString(decryptedData));
   }
   catch
   {
    return new SecureString();
   }
  }

  public static SecureString ToSecureString(string input)
  {
   SecureString secure = new SecureString();
   foreach (char c in input)
   {
    secure.AppendChar(c);
   }
   secure.MakeReadOnly();
   return secure;
  }

  public static string ToInsecureString(SecureString input)
  {
   string returnValue = string.Empty;
   IntPtr ptr = System.Runtime.InteropServices.Marshal.SecureStringToBSTR(input);
   try
   {
    returnValue = System.Runtime.InteropServices.Marshal.PtrToStringBSTR(ptr);
   }
   finally
   {
    System.Runtime.InteropServices.Marshal.ZeroFreeBSTR(ptr);
   }
   return returnValue;
  }
 }