SEO Tools in MS word
Here i have created new tool for SEO optimization using Microsoft Word. Using these tools we can count number of characters used for title, description and keywords tag, number of delimiters symbols used in title tag and also the commas, dots also can be used to find from these tools. we can also find set the limits for the title, description and keywords tag.
Here is the code for SEO tool
Visual Basic Code:
Dim tp As Integer
Dim str, s, s1, sflt, surl As String
Dim count, l, l1, l2, l3, i, j, t As Integer
Dim dt, tt As Date
'Title code
Private Sub Title_Change()
Dim c, commas, dot, dem As Integer
Dim pos As Integer
Dim str As String
l = Len(Title.Text)
If l >= 100 Then
lchar.ForeColor = vbRed
MsgBox "Title Exceeded the Maximum Length"
End If
If l <= 79 Then lchar.ForeColor = vbRed lchar.Caption = "Title is Less than Prefered Length 80" Else lchar.ForeColor = vbGreen lchar.Caption = "Characters Used" End If If l = 0 Then Tchar.Text = "" Tcommos.Text = "" Tamp.Text = "" Tpipe.Text = "" Tdem.Text = "" Tdots.Text = "" lchar.ForeColor = vbBlack lcommas.ForeColor = vbBlack lamp.ForeColor = vbBlack lpipe.ForeColor = vbBlack ldem.ForeColor = vbBlack ldots.ForeColor = vbGreen lchar.Caption = "No Character Used" lcommas.Caption = "No Commas Used" lamp.Caption = "No Ampersand Used" ldem.Caption = "No Delimiters Used" ldots.Caption = "No Dot Used" lpipe.Caption = "No Pipe Used" ElseIf l = 1 Then lchar.Caption = "Character Used" 'lcommas.Caption = "Commas Used" 'lamp.Caption = "Ampersand Used" 'ldem.Caption = "Delimiter Used" 'ldots.Caption = "Dot Used" 'lpipe.Caption = "Pipe Used" End If For j = 1 To l If Mid$(Title.Text, j, 1) = "," Then commas = commas + 1 If commas = 1 Then lcommas.ForeColor = vbGreen lcommas.Caption = "Comma Used" Tcommos.Text = commas ElseIf commas >= 2 Then
lcommas.ForeColor = vbRed
lcommas.Caption = "Commas Exceeded"
Tcommos.Text = commas
ElseIf commas < forecolor =" vbGreen" caption = "No Comma Used" text =" commas" amp =" amp" amp =" 1" forecolor =" vbGreen" caption = "Ampersand used" text =" amp" amp =" 2" forecolor =" vbRed" caption = "Ampersand Exceeded" text =" amp" pipe =" pipe" pipe =" 1" forecolor =" vbGreen" caption = "Pipe Symbol used" text =" pipe">= 2 Then
lpipe.ForeColor = vbRed
lpipe.Caption = "Pipe Symbol Exceeded"
Tpipe.Text = pipe
End If
End If
If Mid$(Title.Text, j, 1) = "." Then
dots = dots + 1
ldots.ForeColor = vbRed
ldots.Caption = "Dont Use Dots in Title"
Tdots.Text = dots
End If
If Mid$(Title.Text, j, 1) = "-" Then
dem = dem + 1
If dem = 1 Then
ldem.ForeColor = vbGreen
ldem.Caption = "Delimiter used"
Tdem.Text = dem
ElseIf dem = 2 Then
ldem.ForeColor = vbRed
ldem.Caption = "Delimiters Exceeded"
Tdem.Text = dem
End If
End If
Next j
End Sub
Private Sub Title_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Tchar.Text = Title.TextLength - 1
If Tchar.Text = "-1" Then
Tchar.Text = "0"
End If
If l <> "," <> "-" <> "." <> "" <> "&" Then
'Tchar.Text = ""
Tcommos.Text = ""
Tamp.Text = ""
Tpipe.Text = ""
Tdem.Text = ""
Tdots.Text = ""
lchar.ForeColor = vbBlack
lcommas.ForeColor = vbBlack
lamp.ForeColor = vbBlack
lpipe.ForeColor = vbBlack
ldem.ForeColor = vbBlack
ldots.ForeColor = vbGreen
'lchar.Caption = "No Character Used"
lcommas.Caption = "No Commas Used"
lamp.Caption = "No Ampersand Used"
ldem.Caption = "No Delimiters Used"
ldots.Caption = "No Dot Used"
lpipe.Caption = "No Pipe Used"
ElseIf l = 1 Then
lchar.Caption = "Character Used"
'lcommas.Caption = "Commas Used"
'lamp.Caption = "Ampersand Used"
'ldem.Caption = "Delimiter Used"
'ldots.Caption = "Dot Used"
'lpipe.Caption = "Pipe Used"
End If
End Sub
Private Sub Title_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Tchar.Text = Title.TextLength + 1
End Sub
'Description Code
Private Sub Desc_Change()
l1 = Len(Desc.Text)
If l1 < forecolor =" vbRed" caption = "Less than 200 Characters">= 200 Then
Kchars.ForeColor = vbGreen
Kchars.Caption = "Characters Used"
MsgBox "Description Exceeded the Maximum Length"
End If
If l1 = 0 Then
Kchars.Caption = "No characters Used"
Kcomma.ForeColor = vbRed
Kcomma.Caption = "No Comma Used"
Dcommos.Text = ""
Damp.Text = ""
Dpipe.Text = ""
Ddots.Text = ""
Ddem.Text = ""
Dchar.Text = ""
End If
For i = 1 To l1
If Mid$(Desc.Text, i, 1) = "," Then
commas = commas + 1
If commas = 1 Then
Kcomma.ForeColor = vbGreen
Kcomma.Caption = "Comma Used"
Dcommos.Text = commas
ElseIf commas > 1 Then
Kcomma.ForeColor = vbGreen
Kcomma.Caption = "commas Used"
Dcommos.Text = commas
End If
End If
Next i
For k = 1 To l1
If Mid$(Desc.Text, k, 1) = "&" Then
amp = amp + 1
Damp.Text = amp
End If
If Mid$(Desc.Text, k, 1) = "" Then
pipe = pipe + 1
Dpipe.Text = pipe
End If
If Mid$(Desc.Text, k, 1) = "." Then
dots = dots + 1
If dots = 1 Then
Kdot.ForeColor = vbGreen
Kdot.Caption = "Dot Used"
Ddots.Text = dots
ElseIf dots > 1 Then
Kdot.ForeColor = vbRed
Kdot.Caption = "Dont Use Dots"
Ddots.Text = dots
End If
End If
If Mid$(Desc.Text, k, 1) = "-" Then
dem = dem + 1
Ddem.Text = dem
End If
If Mid$(Desc.Text, k, 1) = "0" Then
Damp.Text = 0
End If
Next k
End Sub
Private Sub Desc_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dchar.Text = Desc.TextLength - 1
If Dchar.Text = "-1" Then
Dchar.Text = "0"
End If
If l1 <> "," <> "-" <> "." <> "" <> "&" Then
Kdot.ForeColor = vbRed
Kdot.Caption = "No Dot Used"
Kcomma.ForeColor = vbRed
Kcomma.Caption = "No Commas Used"
Dcommos.Text = ""
Damp.Text = ""
Dpipe.Text = ""
Ddem.Text = ""
Ddots.Text = ""
End If
End Sub
Private Sub Desc_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dchar.Text = Desc.TextLength + 1
End Sub
'Keywords Code
Private Sub Keyword_Change()
l3 = Len(Keyword.Text)
If l3 < forecolor =" vbRed" caption = "Less than 300 Characters">= 300 Then
Kcha.ForeColor = vbGreen
Kcha.Caption = "Characters Used"
MsgBox "Keywords Exceeded the Maximum Length"
End If
If l3 = 0 Then
Kcommos.Text = ""
Kamp.Text = ""
Kpipe.Text = ""
Kdem.Text = ""
Kdots.Text = ""
Kchar.Text = ""
End If
s = Keyword.Text
If s <> " " Then
count = count + 1
End If
For i = 0 To s = "\0"
If s = " " Then
While s = " "
i = i + 1
Wend
If i < count =" count" i =" 1" commas =" commas" text =" commas" m =" 1" amp =" amp" text =" amp" text =" 0" pipe =" pipe" text =" pipe" dots =" dots" text =" dots" dem =" dem" text =" dem" text =" Keyword.TextLength" text = "-1" text = "0"> "," <> "-" <> "." <> "" <> "&" Then
Kcommos.Text = ""
Kamp.Text = ""
Kpipe.Text = ""
Kdem.Text = ""
Kdots.Text = ""
End If
End Sub
Private Sub Keyword_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Kchar.Text = Keyword.TextLength + 1
End Sub
