Buenas! Tenía un script con el que me creaba automaticamente la firma del correo electronico de toda la empresa. Todo funcionaba perfectamente, hasta que microsoft ha sacado el office 2007. Resulta q la firma sobre esta suite, deja un espaciado de 10pt sin explicación alguna entre las lineas.
He provado ya varias cosas sin exito, no se lo que hacer. Os adjunto el codigo:
Código:
On Error Resume Next
Const END_OF_STORY = 6
Const MOVE_SELECTION = 0
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strEmail = objUser.Mail
strMovil = objUser.mobile
strNotes = objUser.info
strImagen = "img1.jgp"
strImagen2= "img2.jgp"
strImagen3= "img3.jgp"
strSeparadorAlto = "¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯"
strSeparadorBajo = "_____________________________________________________________________"
Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
Set objWord = CreateObject("Word.Application")
blnWeOpenedWord = True
End If
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objWord.Visible = True
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObjects = objWord.EmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObjects.EmailSignatureEntries
objSelection.Font.Name = "Verdana"
objSelection.Font.Size = "10"
objSelection.TypeText strSeparadorBajo
'objSelection.TypeParagraph()
'objSelection.EndKey END_OF_STORY, MOVE_SELECTION
Set objRange = objSelection.Range
' Creación de tablas
objDoc.Tables.Add objRange, 1, 2
Set objTable = objDoc.Tables(1)
'objTable.Borders.Enable = true
'objTable.Borders.InsideLineStyle = wdLineStyleNone
objTable.Cell(1, 1).Range.ParagraphFormat.SpaceAfter = 0
objTable.Cell(1, 1).Range.Select
objSelection.Font.Name = "Verdana"
objSelection.Font.Size = "8"
objSelection.Font.Bold = True
objSelection.Font.Color = vbBlue
objSelection.Font.Spacing = 0
objSelection.TypeText strName
objSelection.Font.Bold = False
objSelection.Font.Color = vbBlack
objSelection.TypeParagraph
objSelection.TypeText strDepartment
objSelection.TypeParagraph
'objSelection.Hyperlinks.Add objSelection.range, "mailto:" & strEmail, , , strEmail
objSelection.TypeText strEmail
objSelection.TypeParagraph
if strMovil<>"" Then
objSelection.TypeText "Móvil: " & strMovil
objSelection.TypeParagraph
end if
objSelection.TypeParagraph
objSelection.TypeText "C/ forosdelweb, 1"
objSelection.TypeParagraph
objSelection.TypeText "Telf: 91 11 11 11"
if strNotes<>"" Then
objSelection.TypeParagraph
objSelection.TypeText strNotes
end if
objTable.Cell(1, 1).Range.ParagraphFormat.SpaceAfter = 0
objTable.Cell(1, 2).Range.InlineShapes.AddPicture(strImagen)
objSelection.ParagraphFormat.SpaceAfter = 0
objSelection.EndKey END_OF_STORY, MOVE_SELECTION
objSelection.Font.Name = "Verdana"
objSelection.Font.Size = "10"
objSelection.TypeText strSeparadorAlto
objSelection.TypeParagraph()
' Se añade la firma al correo
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Firma", objSelection
objSignatureObjects.NewMessageSignature = "Firma"
objSignatureObjects.ReplyMessageSignature = "Firma"
objDoc.Close 0
If blnWeOpenedWord Then
objWord.Quit
End If
Antes también me dejaba el espaciado dentro del texto de la tabla, pero se soluciono con el objTable.Cell(1, 1).Range.ParagraphFormat.SpaceAfter = 0
También intenté poner la linea superior e inferior de la tabla, pero tampoco soy capaz, unicamente soy capaz de poner todas y quitar después las interiores, las laterales tampoco soy capaz de quitarlas por mucho que lo intente
Saludos,