Ayuda con un script

[mercucho1]

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,