Word VBscript - Remove extra lines in and after table - vbscript

Question

I have a Word vbscript that sets a company signature. I'm trying to figure out how to add lines before the table and remove the extra lines that are showing up after the table.
Here's the code:
Set objSysInfo = CreateObject("ADSystemInfo")
Set WshShell = CreateObject("WScript.Shell")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strFirst = objUser.FirstName
strLast = objUser.LastName
strInitials = objUser.Initials
strOffice = objUser.physicalDeliveryOfficeName
strPOBox = objUser.postOfficeBox
strTitle = objUser.Description
strCred = objUser.info
strStreet = objUser.StreetAddress
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strFax = objUser.FacsimileTelephoneNumber
strEmail = objUser.mail
strCompany = objUser.Company
Set objWord = CreateObject("Word.Application")
Const END_OF_STORY = 6
Const NUMBER_OF_ROWS = 1
Const NUMBER_OF_COLUMNS = 2
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
Set objRange = objDoc.Range()
objDoc.Tables.Add objRange, NUMBER_OF_ROWS, NUMBER_OF_COLUMNS
Set objTable = objDoc.Tables(1)
Dim rngCell
Set rngCell = objTable.Cell(1, 2).Range
objTable.Columns(1).Width = 50
objTable.Columns(2).Width = 360
rngCell.ParagraphFormat.SpaceAfter = 0
rngCell.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
rngCell.ParagraphFormat.LineSpacing = 12
rngCell.Text = strFirst & " " & strInitials & " " & strLast & " | " & _
strOffice & " | " & strCompany & vbCr
rngCell.Font.Bold = True
rngCell.Font.Name = "Calibri"
rngCell.Font.Size = 10
rngCell.Collapse 0 'wdCollapseEnd
rngCell.MoveEnd 1, -1 'wdCharacter, 1
rngCell.Text = strStreet & " | " & strPOBox & " | " & strLocation & vbCr
rngCell.Font.Bold = False
rngCell.Font.Name = "Calibri"
rngCell.Font.Size = 10
rngCell.Collapse 0 'wdCollapseEnd
rngCell.MoveEnd 1, -1 'wdCharacter, 1
rngCell.Text = vbCr & "Phone: " & strPhone & " | " & "Fax: " & strFax & " | " & "Email: " & vbCr
rngCell.Font.Bold = False
rngCell.Font.Name = "Calibri"
rngCell.Font.Size = 10
rngCell.Collapse 0 'wdCollapseEnd
rngCell.MoveEnd 1, -1 'wdCharacter, 1
Set objLink = objTable.Cell(1, 2).Range
objLink.Hyperlinks.Add rngCell, "mailto:" & strEmail,,,strEmail
objLink.Font.Size = 10
objLink.Font.Name = "Calibri"
objSelection.EndKey END_OF_STORY
objSelection.ParagraphFormat.SpaceAfter = 0
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Reply Signature", objSelection
objSignatureObject.ReplyMessageSignature = "Reply Signature"
objDoc.Saved = True
objWord.Quit
(I removed the logo/image in the first column for security reasons), but for some reason, there are extra lines below the text & logo (when it's there) within the table, and there are extra lines below the table. I need those to disappear if possible? Any help would be greatly appreciated! :)
Thanks!

Answer 1

For adding lines before the table, best to add the lines (paragraphs, I assume) before you insert the table. So something like:
objRange.Text = Chr(13) & Chr(13)
objRange.Collapse 0 'end
Set objTable = objDoc.Tables.Add(objRange, NUMBER_OF_ROWS, NUMBER_OF_COLUMNS)