-
Notifications
You must be signed in to change notification settings - Fork 0
/
AssertSignatureFormat.vbs
106 lines (97 loc) · 3.56 KB
/
AssertSignatureFormat.vbs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
'******change module "ThisOutlookSession" and add reference to function *******
'
'Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'
' 'other code...
'
' AssertSignatureFormat Item
'
' 'other code...
'
'End Sub
Public Sub AssertSignatureFormat(oItem As MailItem)
' Thanks to ilcaa72 and msofficeforums.com - https://www.msofficeforums.com/word-vba/19714-loop-through-each-line-word.html
' Thanks to GuruKay and stackoverflow.com - https://stackoverflow.com/a/43166192/6524470
Dim olInspector As Outlook.Inspector
Dim olDocument As Word.Document
Dim wdParagraph As Paragraph
Dim regEx As Variant
Dim Text As String
Set olInspector = Application.ActiveInspector()
Set olDocument = olInspector.WordEditor
Set regEx = CreateObject("vbscript.regexp") 'Initialize the regex object, see AssertSignatureFormat
' uses reference library "Microsoft VBScript Regular Expressions 5.5"
Dim strPattern As String: strPattern = "[^a-zA-Z0-9]" 'The regex pattern to find special characters
Dim strReplace As String: strReplace = "" 'The replacement for the special characters
'uses regEx already created to be equal to CreateObject("vbscript.regexp") 'Initialize the regex object
' Configure the regex object
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "[^a-zA-Z0-9]"
End With
' Perform the regex replacement. Example: strang = regEx.Replace(strang , strReplace)
MsgBoxReturns = vbOK
LineCount = 0
For Each wdParagraph In olDocument.Paragraphs
Text = regEx.replace(wdParagraph.Range.Text, strReplace)
'If MsgBoxReturns <> vbCancel _
Then MsgBoxReturns = MsgBox("""" + Text + """", vbOKCancel)
If Len(Text) > 12 Then
With wdParagraph.Range.Font
Select Case (True)
Case bsc(Text, "PhilipColtharp")
'Signature_Name Style
.Name = "Calibri"
.Bold = True
.Italic = False
.Size = 12
LineCount = 1
End Select
If LineCount > 0 Then
Select Case (True)
Case (bsc(Text, "GovernmentOpe") Or _
bsc(Text, "Office8507173") Or _
bsc(Text, "Fax8504881967") _
) And LineCount
'Sig_Contanct Style
.Name = "Calibri"
.Bold = False
.Italic = False
.Size = 11
Case (bsc(Text, "InspiringSucc") _
) And LineCount
'Sig_Contanct Style
.Name = "Arial"
.Bold = True
.Italic = True
.Size = 11
Case (bsc(Text, "CONFIDENTIALI") _
) And LineCount
'Sig_Note Style
.Name = "Calibri"
.Bold = True
.Italic = False
.Size = 9
Case Else
End Select
End If
End With
End If
Select Case (LineCount)
Case Is > 15
LineCount = 0
Case Is > 0
LineCount = LineCount + 1
Case Else
End Select
Next
End Sub
Private Function bsc(leeft As String, reight As String) 'Bounded String Compare
l = min(Len(leeft), Len(reight))
bsc = (Left(leeft, l) = Left(reight, l))
End Function
Private Function min(x, y As Variant) As Variant
min = IIf(x < y, x, y)
End Function