Word VBscript - 删除表中和表后的额外行

时间:2016-02-02 18:40:46

标签: vbscript ms-word

我有一个设置公司签名的Word vbscript。我试图弄清楚如何在表格之前添加线条,并删除表格后面显示的额外线条。

以下是代码:

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

(出于安全原因,我删除了第一栏中的徽标/图片),但出于某种原因,文字和文字下面还有一些额外的行。表格内的标识(当它在那里时),表格下方有额外的行。如果可能,我需要那些消失吗?任何帮助将不胜感激! :)

谢谢!

1 个答案:

答案 0 :(得分:0)

要在表格之前添加行,最好在插入表格之前添加行(我假设的段落)。如下所示:

objRange.Text = Chr(13) & Chr(13)
objRange.Collapse 0 'end
Set objTable = objDoc.Tables.Add(objRange, NUMBER_OF_ROWS, NUMBER_OF_COLUMNS)