My current macro code (see code below) finds all instances of the following three string formats (which are work order #'s) in a Word 2010 file (the file can be anywhere from 10 to 100 pages) and pastes them into a new Word file, one string per line:
AAA-#### (where AAA could be any letter from A – Z, followed by a dash, then 4 numbers)
####-####### (4 numbers, followed by a dash, then 7 numbers)
AAA-##-#### (where AAA could be any letter from A – Z, followed by a dash, 2 numbers, a dash, then 4 numbers)
Two changes I would like to make to the above current macro:
I would like to update the macro so it only searches for one of the three text strings above (as the other two text strings have since become obsolete) to then paste into a new Word file, one string per line:
####-####### (4 numbers, followed by a dash, then 7 numbers)
I would like the macro to generate an error message as a dialog pop-up box at the first instance it comes across a text string that does not follow the approved format as outlined above (####-####### [4 numbers, followed by a dash, then 7 numbers], with the error message that includes the problem text string (work order #) to assist the user in locating the erroneously-entered work order number in the document and fixing it. Once the user corrected the work order number, the user would then re-run the macro.
The two instances of wrongly formatted strings for the macro to detect and generate an error message are as follows:
####-###### (4 numbers, followed by a dash, then 6 numbers)
####-######## (4 numbers, followed by a dash, then 8 numbers)
The error message will ensure going forward that we are not missing any work order numbers being transferred by the macro to the new Word file due to the user mis-keying in the work orders by accidentally adding or subtracting one digit.
I've attached a sample Word file showing the two examples of wrongly-formatted text strings that can occur and for which I would like the macro to generate an error message.
And here's the answer:
Sub Extract_WOs_ADCs()
'
' Extract_WOs_ADCs Macro
'
' Keyboard Shortcut: Ctrl+y
'
Set Activedoc = ActiveDocument
strRes = ""
Dim reg As Object 'VBScript_RegExp_55.regexp
Dim Match As Object ' VBScript_RegExp_55.Match
Dim Matches As Object 'VBScript_RegExp_55.MatchCollection
' instanciation
Set reg = CreateObject("VBScript.RegExp")
With reg
.Global = True
.MultiLine = True
.Ignorecase = True
.Pattern = "\b\d{4}-(\d{6}|\d{8})\b"
Set Matches = .Execute(Activedoc.Range.Text)
End With
For Each Match In Matches
ActiveDocument.Range(Match.firstIndex, Match.firstIndex + Match.Length).Select
MsgBox "Value: " & Match.Value & " is wrong"
Exit Sub
Next Match
reg.Pattern = "\b\d{4}-\d{7}\b"
Set Matches = reg.Execute(Activedoc.Range.Text)
For Each Match In Matches
strRes = strRes & Match.Value & vbCrLf
Next Match
If strRes <> "" Then
Set newDoc = Documents.Add
newDoc.Range.Text = strRes
Else
MsgBox "No Matches"
End If
End Sub
Do you know what's really cool about this website? In the comment with the code above, there are these tools that are extremely helpful:
- Select all
- Open in new window
Totally helpful.
No comments:
Post a Comment