Question

我目前正在研究一个脚本，以在我们公司范围内生成签名。

我可以设置一个新的并回复签名，但是我需要一些帮助。

对于新邮件中的表格，只要有人回复，如下图所示，电话桌上方有多余的空间。如何消除表格的额外空间和格式（每个单元格之间似乎有多余的填充或内容，因为行距比副本的其余部分大。

我不知道回复纯文本电子邮件时如何格式化电子邮件，请参见下图。首先，表格单元格变为行，徽标变为多余的空格。我应该如何格式化纯文本表格，或者如果更简单，在回复纯文本电子邮件时如何删除图像？

下面是我的代码：

' On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

'--------------------------------------------------------------------------
' Connect to Active Directory as the currently logged on user
'--------------------------------------------------------------------------
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)  

'--------------------------------------------------------------------------
' Set up variables
'--------------------------------------------------------------------------
strGiven = objuser.givenName
strSurname = objuser.sn
strTitle = objUser.Title
strCompany = objUser.Company
strLogo = "http://www.xtremecubescorp.com/wp-content/themes/xmfg_s/images/email-sig/xtreme-cubes-corporation.gif"
strWebsite = "http://www.xtremecubescorp.com"
strAddress1 = objUser.streetaddress
strAddress1EXT = objUser.postofficebox
strAddress2 = objuser.l
strAddress3 = objuser.st
strPostcode = objuser.postalcode
strCountry = objuser.c
strPhone = objUser.telephoneNumber
strFax = objuser.facsimileTelephoneNumber
strMobile = objuser.mobile
strEmail = objuser.mail
strDisclaimrP1 = "The email and attachments hereto are strictly confidential and intended solely for the addressee. If you are not the intended addressee, please notify the sender by return and delete the message. You must not disclose, forward or copy this email or attachments to any third party without prior consent of the sender. The integrity and security of this email cannot be guaranteed over the Internet. Therefore, the sender nor the company for which he or she works will not be held liable for any damage caused by the message."
strDisclaimrP2 = "The Xtreme CUBES name and logos, and all related product and service names, design marks and slogans are the trademarks of Xtreme CUBES. All rights are expressly reserved herein. Any reproduction, copies, or exploitation in any manner and for any purpose without the express written consent of Xtreme CUBES is strictly prohibited."

'--------------------------------------------------------------------------
' Convert case
'--------------------------------------------------------------------------
intGiven = Len(strGiven)
strFirstLetter = UCase(Left(strGiven , 1))
strRemainingLetters = LCase(Right(strGiven , intGiven - 1))
strGiven = strFirstLetter & strRemainingLetters

intSurname = Len(strSurname)
strFirstLetter = UCase(Left(strSurname , 1))
strRemainingLetters = LCase(Right(strSurname , intSurname - 1))
strSurname = strFirstLetter & strRemainingLetters

strEmailCon = lcase(strEmail)
strPostcode5 = Left(strPostcode,5)

arrStr = split(strTitle," ")  
For i=0 to ubound(arrStr)
    word = lcase(trim(arrStr(i))) 
    word = replace(word,mid(word,1,1),ucase(mid(word,1,1)),1,1)
    strTitleCon = strTitleCon & word & " "
Next

arrStr = split(strAddress1," ")
For i=0 to ubound(arrStr)
    word = lcase(trim(arrStr(i))) 
    word = replace(word,mid(word,1,1),ucase(mid(word,1,1)),1,1)                  
    strAddress1Con = strAddress1Con & word & " "
Next

arrStr = split(strAddress2," ")
lastStrAddress2Con = arrStr(ubound(arrStr))
lastStrAddress2Con = lcase(trim(lastStrAddress2Con)) 
lastStrAddress2Con = replace(lastStrAddress2Con,mid(lastStrAddress2Con,1,1),ucase(mid(lastStrAddress2Con,1,1)),1,1)
For i=0 to (ubound(arrStr)-1)
    word = lcase(trim(arrStr(i))) 
    word = replace(word,mid(word,1,1),ucase(mid(word,1,1)),1,1)                  
    strAddress2Con = strAddress2Con & word & " "
Next

'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
' Set up word template for full signature
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Style = "No Spacing"
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

objSelection.Font.Name = "Calibri"
objSelection.Font.Size = 11
objselection.Font.Bold = true
objSelection.Font.Color = RGB (000,000,000)


'--------------------------------------------------------------------------
' Email Signature Content
'--------------------------------------------------------------------------
With objSelection.InlineShapes.AddHorizontalLineStandard
 .Width = 200
 .HorizontalLineFormat.Alignment = 0
End With

' Name
objSelection.TypeText strGiven & " " & strSurname
objselection.TypeText Chr(11)

' Title
objSelection.TypeText strTitleCon
objselection.TypeText Chr(11)

' Company Name
objselection.TypeText "Xtreme CUBES" & chr(153)
objSelection.InlineShapes.AddHorizontalLineStandard
objselection.TypeText Chr(11)

' Logo
If (strLogo <> "") Then
    Set objLink = objSelection.Hyperlinks.Add(objSelection.InlineShapes.AddPicture(strLogo), strWebsite,,,"")
    objselection.TypeText Chr(11)
    objselection.TypeText Chr(11)
End If

' Address
objselection.Font.Bold = false

If (objUser.postofficebox = "") Then

objSelection.TypeText strAddress1Con
objselection.TypeText Chr(11)

objSelection.TypeText strAddress2Con & lastStrAddress2Con & ", " & strAddress3 & " " & strPostcode5
objselection.TypeText Chr(11)

Else

objSelection.TypeText strAddress1Con
objselection.TypeText Chr(11)

objSelection.TypeText strAddress1Ext
objselection.TypeText Chr(11)

objSelection.TypeText strAddress2Con & lastStrAddress2Con & ", " & strAddress3 & " " & strPostcode5


End If

' Phone, mobile, fax
Set objRange = objSelection.Range
objDoc.Tables.Add objRange, 3,2
Set objTable = objDoc.Tables(1)

With objTable
    .AutoFitBehavior(1)
    .LeftPadding = 0.4
    .RightPadding = 0
    .TopPadding = 0
    .BottomPadding = 0
    .Range.Collapse 0
End With

If (strPhone <> "") Then
objTable.Cell(1, 1).Range.Text = "T"
objTable.Cell(1, 2).Range.Text = ": +1 " & strPhone
End If

If (strMobile <> "") Then
objTable.Cell(2, 1).Range.Text = "M"
objTable.Cell(2, 2).Range.Text = ": +1 " & strMobile
End If

If (strFax <> "") Then
objTable.Cell(3, 1).Range.Text = "F"
objTable.Cell(3, 2).Range.Text = ": +1 " & strFax
End If

objSelection.EndKey 6

' Website
Const wdParagraph = 3
Const wdExtend = 1
Const wdCollapseEnd = 0

Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "http://www.xtremecubescorp.com", , , "www.xtremecubescorp.com")
objLink.Range.Font.Size = 10
objLink.Range.Font.Bold = True
objLink.Range.Font.Underline = wdUnderlinNone
objLink.Range.Font.UnderlineColor = RGB(000,000,000)
objSelection.Font.Name = "Calibri"
objselection.TypeText Chr(11)
objselection.TypeText Chr(11)

objSelection.StartOf wdParagraph, wdExtend
objSelection.Font.Color = RGB(000,000,000)
objSelection.Collapse wdCollapseEnd

' Disclaimer
objSelection.Font.Size = 8
objselection.Font.Bold = false
objSelection.Font.Color = RGB (85,85,85)

objSelection.TypeText strDisclaimrP1
objselection.TypeText Chr(11)
objselection.TypeText Chr(11)

objSelection.TypeText strDisclaimrP2
objselection.TypeText Chr(11)

'--------------------------------------------------------------------------
' Tells outlook to use this signature for new messages
'--------------------------------------------------------------------------
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Full Signature", objSelection
objSignatureObject.NewMessageSignature = "Full Signature"
objDoc.Saved = True
objWord.Quit



'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
' Set up word template for reply and forward signature
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Style = "No Spacing"
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

objSelection.Font.Name = "Calibri"
objSelection.Font.Size = 11
objselection.Font.Bold = true
objSelection.Font.Color = RGB (000,000,000)

'--------------------------------------------------------------------------
' Email Signature Content
'--------------------------------------------------------------------------
With objSelection.InlineShapes.AddHorizontalLineStandard
 .Width = 200
 .HorizontalLineFormat.Alignment = 0
End With

' Name
objSelection.TypeText strGiven & " " & strSurname
objselection.TypeText Chr(11)

' Title
objSelection.TypeText strTitleCon
objselection.TypeText Chr(11)

' Company Name
objselection.TypeText "Xtreme CUBES" & chr(153)
objSelection.InlineShapes.AddHorizontalLineStandard
objselection.TypeText Chr(11)

' Logo
If (strLogo <> "") Then
    Set objLink = objSelection.Hyperlinks.Add(objSelection.InlineShapes.AddPicture(strLogo), strWebsite,,,"")
    objselection.TypeText Chr(11)
    objselection.TypeText Chr(11)
End If

' Phone
If (strPhone <> "") Then
objselection.Font.Bold = False
objSelection.TypeText "T: +1 " & strPhone
objselection.TypeText Chr(11)
End If

' Website
Const wdParagraph2 = 3
Const wdExtend2 = 1
Const wdCollapseEnd2 = 0

Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "http://www.xtremecubescorp.com", , , "www.xtremecubescorp.com")
objLink.Range.Font.Size = 10
objLink.Range.Font.Bold = True
objLink.Range.Font.Underline = wdUnderlinNone
objLink.Range.Font.UnderlineColor = RGB(000,000,000)
objSelection.Font.Name = "Calibri"
objselection.TypeText Chr(11)
objselection.TypeText Chr(11)

objSelection.StartOf wdParagraph2, wdExtend2
objSelection.Font.Color = RGB(000,000,000)
objSelection.Collapse wdCollapseEnd2

' Disclaimer
objSelection.Font.Size = 8
objselection.Font.Bold = false
objSelection.Font.Color = RGB (85,85,85)

objSelection.TypeText strDisclaimrP1
objselection.TypeText Chr(11)
objselection.TypeText Chr(11)

objSelection.TypeText strDisclaimrP2
objselection.TypeText Chr(11)

'--------------------------------------------------------------------------
' Tells outlook to use this signature for reply messages
'--------------------------------------------------------------------------
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Reply Signature", objSelection
objSignatureObject.ReplyMessageSignature = "Reply Signature"
objDoc.Saved = True
objWord.Quit

vbscript删除图像和表格格式

0 个答案: