VBScript Outlook签名单元格填充

时间:2018-05-29 15:31:59

标签: vbscript outlook ms-word signature

我正在创建一个从AD获取数据的自动Outlook签名。一切顺利,但我不断在表格单元格上获得空格(看起来像填充或其他东西)。

On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" + strUser)

strName = objUser.givenName
strSurName = objUser.Sn
strFullName = objUser.Fullname
strTitle = objUser.Title
strAdres = objUser.address
strPhone = objUser.TelephoneNumber
strMob = objUser.Mobile
strEmail = objUser.mail
strMarBoo = objUser.StreetAddress
strMarLinkTxt = objUser.postOfficeBox
strMarLink = objUser.l
strDescription = objUser.Description
strIT = ""

Set objWord = CreateObject("Word.Application")

Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

objSelection.ParagraphFormat.LineSpacing = 14
objSelection.TypeText "Met vriendelijke groet, "
objSelection.TypeText Chr(11)
objSelection.TypeText Chr(11)
'objSelection.Font.Color = RGB(240,73,6)
objSelection.Font.Bold = True
objSelection.TypeText strFullName
objSelection.Font.Bold = False
objSelection.TypeText Chr(11)
objSelection.Font.Color = RGB(47,84,150)
objSelection.Font.Size = 11

objSelection.TypeText strTitle + Chr(11)
objSelection.Font.Size = 11
objSelection.Font.Color = RGB(47,84,150)
Set objRange = objSelection.Range
objDoc.Tables.Add objRange, 3, 5

Set objTable1 = objDoc.Tables(1)
objTable1.TopPadding = PixelsToPoints(10, True)
objTable1.BottomPadding = PixelsToPoints(10, True)

'Merge cells in col 1
objTable1.Columns(1).Cells.Merge

objTable1.Columns(1).PreferredWidth = 90
objTable1.Columns(2).PreferredWidth = 100
objTable1.Columns(3).PreferredWidth = 150
objTable1.Columns(4).PreferredWidth = 100
objTable1.Columns(5).PreferredWidth = 200

'----------------KOLOM 1------------------------------
objTable1.Cell(1,1).Range.InlineShapes.AddPicture "\\int-vm-    pdc\NETLOGON\logo_rondje_oranje_small.png"

'----------------KOLOM 2------------------------------
objTable1.Cell(1,2).Range.Font.Bold = True
objTable1.Cell(1,2).Range.Font.Color = RGB(240,73,6)
objTable1.Cell(2,2).Range.Font.Bold = True
objTable1.Cell(2,2).Range.Font.Color = RGB(240,73,6)
objTable1.Cell(3,2).Range.Font.Bold = True
objTable1.Cell(3,2).Range.Font.Color = RGB(240,73,6)

objTable1.Cell(1,2).Range.Text = "Bezoekadres"
objTable1.Cell(2,2).Range.Text = "Hoofdnummer"
objTable1.Cell(3,2).Range.Text = "Rechtstreeks"

'----------------KOLOM 3------------------------------
objTable1.Cell(1,3).Range.Text = strAdres
objTable1.Cell(2,3).Range.Text = strPhone
objTable1.Cell(3,3).Range.Text = strMob

'----------------KOLOM 4------------------------------
objTable1.Cell(1,4).Range.Font.Bold = True
objTable1.Cell(1,4).Range.Font.Color = RGB(240,73,6)
objTable1.Cell(2,4).Range.Font.Bold = True
objTable1.Cell(2,4).Range.Font.Color = RGB(240,73,6)    
objTable1.Cell(3,4).Range.Font.Bold = True
objTable1.Cell(3,4).Range.Font.Color = RGB(240,73,6)

objTable1.Cell(1,4).Range.Text = "Emailadres"
objTable1.Cell(2,4).Range.Text = "Website"

'----------------KOLOM 5------------------------------
Set objCell = objTable1.Cell(1,5).Range
Set objLink = objSelection.Hyperlinks.Add(objCell, "mailto:"&strEmail, , ,strEmail)

Set objCell = objTable1.Cell(2,5).Range
Set objLink = objSelection.Hyperlinks.Add(objCell, "https://www.company.com", , ,"https://www.company.com")

objTable1.Cell(3,5).Range.Text = strDescription

objSelection.EndKey 6

With Selection.ParagraphFormat
    .SpaceBefore = 0
    .SpaceBeforeAuto = False
    .SpaceAfter = 0
    .SpaceAfterAuto = False
    .LineSpacingRule = wdLineSpaceSingle
End With

Set objSelection = objDoc.Range()

objSignatureEntries.Add "Handtekening_2018_extended", objSelection
objSignatureObject.NewMessageSignature = "Handtekening_2018_extended"
objSignatureObject.ReplyMessageSignature = "Handtekening_2018_extended"

objDoc.Saved = True
objWord.Quit

有关结果的屏幕截图,请参阅图片:

enter image description here

已经尝试设置Font.LineHeightobjTable1.Rows(1).Height,但似乎没有任何效果。

任何人都知道如何解决这个问题?

也许有一些我找不到关于样式的更详细的文档?

0 个答案:

没有答案