Extract first n characters based on predefined delimiter

Question

I currently have a cope snippet that allows me to extract the first 6 characters of a filename to insert in the right of a document footer and the file title (not including extension) in the left of the footer. It was all based on character position and had served its purpose. However, a complexity has been introduced.

Our previous file naming structure was solely "###### - [Title]" (where we had 6 digits, a space, dash, a space, a title). We now have additional file names of the format "######.## - [TITLE]". I don't believe I can rely solely on character position to achieve extraction and insertion. I'm looking for some assistance in how I might be able to setup the code to determine whether the 7th character is a decimal or a space and proceed accordingly with inserting ##### versus ######.## into the footer. The flip side would also be true where I would need to determine the actual title (not relying on the position since it would be dependent on the first case.

Any assistance is appreciated. Below is the current code. It might not be the cleanest, but it gets the job done:

Sub FooterFields(myFooterHL, myTotalPageCount, myFooterBold)

    sTitle = ActiveDocument.Name
    J = InStrRev(sTitle, ".")
    If J > 0 Then
        sTitle = Left(sTitle, J - 9)
        If Len(sTitle) > 5 Then
            sTitle = Left(sTitle, 9)
        End If

        Dim specTitle As String
        Dim specTitle2 As String
        Dim specTitleInt As String

        specTitle = ActiveDocument.Name
        If Right(specTitle, 5) = ".docx" Then
            specTitleInt = Left(specTitle, Len(specTitle) - 5)
            specTitle2 = Right(specTitleInt, Len(specTitleInt) - 9)
        ElseIf Right(specTitle, 4) = ".doc" Then
            specTitleInt = Left(specTitle, Len(specTitle) - 4)
            specTitle2 = Right(specTitleInt, Len(specTitleInt) - 9)
        Else
        End If

        sDiv = ActiveDocument.Name
        K = InStrRev(sDiv, ".")
        If K > 0 Then
            sDivIntermediate = Right(sDiv, K - 6)
            sDivFinal = specTitle2
            If Len(sDiv) > 5 Then
                sDivIntermediate = Right(sDiv, K - 6)
                sDivFinal = specTitle2
            End If

            If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
                ActiveWindow.Panes(2).Close
            End If
            If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
               ActivePane.View.Type = wdOutlineView Then
                ActiveWindow.ActivePane.View.Type = wdPrintView
            End If
            ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
            Selection.WholeStory
            Selection.Delete
            Selection.Font.AllCaps = True

            With Selection
                .Range.Text = sTitle
                .Range.InsertAlignmentTab wdRight, wdMargin
                .EndKey Unit:=wdLine
                .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="PAGE  ",
                PreserveFormatting:=True

                If myTotalPageCount = vbYes Then
                    .TypeText Text:="/"
                    .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
                    Text:="NUMPAGES  ", PreserveFormatting:=True
                Else
                End If

                .HomeKey Unit:=wdLine
                .Range.Text = sDivFinal

            End With

            PageNumberAlignment:=wdAlignPageNumberRight, FirstPage:=True


            ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        Else
            MsgBox "Document has no filename extension."
        End If
    End If

End Sub

Answer 1

I would suggest you consider using regular expressions for this. (The link is for using regular expressions in VBA hosted under Excel, but most of the information applies to VBA hosted under Word as well.)

---

A short introduction to regular expressions:

• Define a pattern
• Find one or more matches to the pattern in a string

---

You could use the following pattern to match all the variations:

^\d{6}(?:\.\d{2}) - .*(?:\.doc|\.docx)$

Add a reference (Tools -> References...) to the Microsoft VBScript Regular Expressions 5.5 library. Then you can use something like the following:

Sub FooterFields2(myFooterHL, myTotalPageCount, myFooterBold)
    Dim re As New RegExp
    re.Pattern = "^(\d{6}(?:\.\d{2})) - (.*)(?:\.doc|\.docx)$"
    re.IgnoreCase = True

    Dim matches As MatchCollection
    Set matches = re.Execute(ActiveDocument.Name)
    If matches.Count = 0 Then
        MsgBox "Document name doesn't match"
        Exit Sub
    End If

    Dim match As match
    Set match = matches(0)

    Dim code As String, title As String
    code = match.SubMatches(0)
    title = match.SubMatches(1)

    'insert code and title in the appropriate location


End Sub

---

Explanation

\d -- matches a single digit character
\d{6} -- matches exactly 6 digits

\. -- matches a .. Because the . is a part of regular expression syntax, it has to be escaped with a \
\.\d{2} -- matches a . followed by (as before) exactly two digits
(?:\.\d{2}) -- groups \.\d{2} so we can apply an operator. Grouping with (?: (as opposed to with () does not store the value within the group to be referenced separately
(?:\.\d{2})?-- matches zero or one instances of (?:\.\d{2}), because the title might have the decimal and two successive digits, or it might not

- .* -- matches a space, a dash, and a space, followed by any number (*) of any character (.)

\.doc|\.docx -- matches either .doc or .docx
(?:\.doc|\.docx) -- groups together the different variants of the extension, but doesn't save the extension for further use

---

In order to extract the digits and the title after we've matched against the regular epression, we need to use capturing groups, which are indicated by parentheses -- (). In this case we want the numeric code (first capturing group) and the title (second capturing group):

(\d{6}(?:\.\d{2})) - (.*)(?:\.doc|\.docx)