Seo tools in ms word using vb code

harikumar86 0 Tallied Votes 290 Views Share
Dim tp As Integer
Dim str, flt(), strflt, sflt As String
Dim l, l1, l2, l3, i, j, t As Integer

'Title code
Private Sub Title_Change()
Dim commas As Integer
Dim pos As Integer
Dim str As String
l = Len(Title.Text)
If l >= 80 Then
MsgBox "Title Exceeded the Maximum Length"
End If

If l = 0 Then
Tchar = 0
Tcommos.Text = 0
Tamp.Text = 0
Tpipe.Text = 0
Tdem = 0
Tdots = 0
End If

For j = 1 To l
If Mid$(Title.Text, j, 1) = "," Then
commas = commas + 1
Tcommos.Text = commas
End If
If Mid$(Title.Text, j, 1) = "&" Then
amp = amp + 1
Tamp.Text = amp
End If
If Mid$(Title.Text, j, 1) = "|" Then
pipe = pipe + 1
Tpipe.Text = pipe
End If
If Mid$(Title.Text, j, 1) = "0" Then
Tamp.Text = 0
End If
If Mid$(Title.Text, j, 1) = "." Then
dots = dots + 1
Tdots.Text = dots
End If
If Mid$(Title.Text, j, 1) = "-" Then
dem = dem + 1
Tdem.Text = dem
End If
Next j
End Sub
Private Sub Title_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Tchar.Text = Title.TextLength - 1

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 >= 200 Then
MsgBox "Description Exceeded the Maximum Length"
End If
If l1 = 0 Then
Dcommos.Text = 0
Damp.Text = 0
Dpipe.Text = 0
Ddots.Text = 0
Ddem.Text = 0
Dchar.Text = 0
End If
For i = 1 To l1
If Mid$(Desc.Text, i, 1) = "," Then
commas = commas + 1
Dcommos.Text = commas
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
Ddots.Text = dots
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
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 >= 300 Then
MsgBox "Keywords Exceeded the Maximum Length"
End If
If l3 = 0 Then
Kcommos.Text = 0
Kamp.Text = 0
Kpipe.Text = 0
Kdem = 0
Kdots = 0
End If
For i = 1 To l3
If Mid$(Keyword.Text, i, 1) = "," Then
commas = commas + 1
Kcommos.Text = commas
End If
Next i
For m = 1 To l3
If Mid$(Keyword.Text, m, 1) = "&" Then
amp = amp + 1
Kamp.Text = amp
End If
If Mid$(Keyword.Text, m, 1) = "0" Then
Kamp.Text = 0
End If
If Mid$(Keyword.Text, m, 1) = "|" Then
pipe = pipe + 1
Kpipe.Text = pipe
End If
If Mid$(Keyword.Text, m, 1) = "." Then
dots = dots + 1
Kdots.Text = dots
End If
If Mid$(Keyword.Text, m, 1) = "-" Then
dem = dem + 1
Kdem.Text = dem
End If
Next m
End Sub

Private Sub Keyword_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Kchar.Text = Keyword.TextLength - 1
End Sub

Private Sub Keyword_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Kchar.Text = Keyword.TextLength + 1
End Sub
Dim tp As Integer
Dim str, flt(), strflt, sflt As String
Dim l, l1, l2, l3, i, j, t As Integer

'Title code
Private Sub Title_Change()
Dim commas As Integer
Dim pos As Integer
Dim str As String
l = Len(Title.Text)
If l >= 80 Then
MsgBox "Title Exceeded the Maximum Length"
End If

If l = 0 Then
Tchar = 0
Tcommos.Text = 0
Tamp.Text = 0
Tpipe.Text = 0
Tdem = 0
Tdots = 0
End If

For j = 1 To l
If Mid$(Title.Text, j, 1) = "," Then
commas = commas + 1
Tcommos.Text = commas
End If
If Mid$(Title.Text, j, 1) = "&" Then
amp = amp + 1
Tamp.Text = amp
End If
If Mid$(Title.Text, j, 1) = "|" Then
pipe = pipe + 1
Tpipe.Text = pipe
End If
If Mid$(Title.Text, j, 1) = "0" Then
Tamp.Text = 0
End If
If Mid$(Title.Text, j, 1) = "." Then
dots = dots + 1
Tdots.Text = dots
End If
If Mid$(Title.Text, j, 1) = "-" Then
dem = dem + 1
Tdem.Text = dem
End If
Next j
End Sub
Private Sub Title_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Tchar.Text = Title.TextLength - 1

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 >= 200 Then
MsgBox "Description Exceeded the Maximum Length"
End If
If l1 = 0 Then
Dcommos.Text = 0
Damp.Text = 0
Dpipe.Text = 0
Ddots.Text = 0
Ddem.Text = 0
Dchar.Text = 0
End If
For i = 1 To l1
If Mid$(Desc.Text, i, 1) = "," Then
commas = commas + 1
Dcommos.Text = commas
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
Ddots.Text = dots
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
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 >= 300 Then
MsgBox "Keywords Exceeded the Maximum Length"
End If
If l3 = 0 Then
Kcommos.Text = 0
Kamp.Text = 0
Kpipe.Text = 0
Kdem = 0
Kdots = 0
End If
For i = 1 To l3
If Mid$(Keyword.Text, i, 1) = "," Then
commas = commas + 1
Kcommos.Text = commas
End If
Next i
For m = 1 To l3
If Mid$(Keyword.Text, m, 1) = "&" Then
amp = amp + 1
Kamp.Text = amp
End If
If Mid$(Keyword.Text, m, 1) = "0" Then
Kamp.Text = 0
End If
If Mid$(Keyword.Text, m, 1) = "|" Then
pipe = pipe + 1
Kpipe.Text = pipe
End If
If Mid$(Keyword.Text, m, 1) = "." Then
dots = dots + 1
Kdots.Text = dots
End If
If Mid$(Keyword.Text, m, 1) = "-" Then
dem = dem + 1
Kdem.Text = dem
End If
Next m
End Sub

Private Sub Keyword_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Kchar.Text = Keyword.TextLength - 1
End Sub

Private Sub Keyword_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Kchar.Text = Keyword.TextLength + 1
End Sub
seoathar 0 Newbie Poster

its a crap, its just a MS word document with some VB code in it.
It doesnt work well when compared to other tools for title and meta tags

harikumar86 0 Newbie Poster

Hi Athar. This code is useful for to count optimize the meta tags in SEO process. We can easily count number of characters used and create alert for illegal characters that are not useful for our website. \
I think it will be useful for some concern for their project work.

by
Hari..

harikumar86 0 Newbie Poster

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.

Dim tp As Integer
Dim str, flt(), strflt, sflt As String
Dim l, l1, l2, l3, i, j, t As Integer

'Title code
Private Sub Title_Change()
Dim commas As Integer
Dim pos As Integer
Dim str As String
l = Len(Title.Text)
If l >= 80 Then
MsgBox "Title Exceeded the Maximum Length"
End If

If l = 0 Then
Tchar = 0
Tcommos.Text = 0
Tamp.Text = 0
Tpipe.Text = 0
Tdem = 0
Tdots = 0
End If

For j = 1 To l
If Mid$(Title.Text, j, 1) = "," Then
commas = commas + 1
Tcommos.Text = commas
End If
If Mid$(Title.Text, j, 1) = "&" Then
amp = amp + 1
Tamp.Text = amp
End If
If Mid$(Title.Text, j, 1) = "|" Then
pipe = pipe + 1
Tpipe.Text = pipe
End If
If Mid$(Title.Text, j, 1) = "0" Then
Tamp.Text = 0
End If
If Mid$(Title.Text, j, 1) = "." Then
dots = dots + 1
Tdots.Text = dots
End If
If Mid$(Title.Text, j, 1) = "-" Then
dem = dem + 1
Tdem.Text = dem
End If
Next j
End Sub
Private Sub Title_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Tchar.Text = Title.TextLength - 1

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 >= 200 Then
MsgBox "Description Exceeded the Maximum Length"
End If
If l1 = 0 Then
Dcommos.Text = 0
Damp.Text = 0
Dpipe.Text = 0
Ddots.Text = 0
Ddem.Text = 0
Dchar.Text = 0
End If
For i = 1 To l1
If Mid$(Desc.Text, i, 1) = "," Then
commas = commas + 1
Dcommos.Text = commas
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
Ddots.Text = dots
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
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 >= 300 Then
MsgBox "Keywords Exceeded the Maximum Length"
End If
If l3 = 0 Then
Kcommos.Text = 0
Kamp.Text = 0
Kpipe.Text = 0
Kdem = 0
Kdots = 0
End If
For i = 1 To l3
If Mid$(Keyword.Text, i, 1) = "," Then
commas = commas + 1
Kcommos.Text = commas
End If
Next i
For m = 1 To l3
If Mid$(Keyword.Text, m, 1) = "&" Then
amp = amp + 1
Kamp.Text = amp
End If
If Mid$(Keyword.Text, m, 1) = "0" Then
Kamp.Text = 0
End If
If Mid$(Keyword.Text, m, 1) = "|" Then
pipe = pipe + 1
Kpipe.Text = pipe
End If
If Mid$(Keyword.Text, m, 1) = "." Then
dots = dots + 1
Kdots.Text = dots
End If
If Mid$(Keyword.Text, m, 1) = "-" Then
dem = dem + 1
Kdem.Text = dem
End If
Next m
End Sub

Private Sub Keyword_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Kchar.Text = Keyword.TextLength - 1
End Sub

Private Sub Keyword_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Kchar.Text = Keyword.TextLength + 1
End Sub
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.