Solved

VBA script problem - Can't alter table cell widths

Posted on 2008-09-29
6
1,118 Views
Last Modified: 2010-08-05
I have created the atached logon script to generate an email signature for all my users based on information pulled from AD. It works almost perfectly, except that the table cells are not resized properly, they are always left on the default size. Why is the line that sets the width not working? Have I done something silly?
Thanks
On Error Resume Next
 

Set objSysInfo = CreateObject("ADSystemInfo")
 

strUser = objSysInfo.UserName

Set objUser = GetObject("LDAP://" & strUser)
 

strName = objUser.FullName

strTitle = objUser.Title

strAddress = objUser.streetAddress

strCity = objUser.l

strState = objUser.st

strPostCode = objUser.PostalCodes

strExt = objUser.TelephonePager

strPhone = objUser.telephoneNumber

strFax = objUser.faxnumber

strMobile = objUser.TelephoneMobile
 

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.SpaceBefore=0

    objSelection.ParagraphFormat.SpaceAfter=0

    objSelection.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle

    Set objRange = objSelection.Range

    Set objTable = objDoc.Tables.Add(objRange,1,1,wdWord8TableBehavior)

    objTable.Columns(1).Width = CentimetersToPoints(8.6)

    objSelection.Font.Name = "Verdana"

    objSelection.Font.Size = 10

    objSelection.Font.Color = 2108888

    objSelection.TypeText "_______________________"

    objSelection.TypeParagraph

    objSelection.Font.Bold = True

    objSelection.Font.Color = -587137025

    objSelection.TypeText strName

    objSelection.Font.Color = -603946753

    objSelection.TypeParagraph

    objSelection.Font.Bold = False

    objSelection.TypeText strTitle

    objSelection.Font.Size = 5

    objSelection.TypeParagraph

    objSelection.TypeParagraph

    objSelection.Font.Size = 8

    objSelection.TypeText strAddress

    objSelection.TypeParagraph

    objSelection.TypeText strCity

    objSelection.TypeParagraph

    objSelection.TypeText strState

    objSelection.TypeParagraph

    objSelection.TypeText strPostCode

    objSelection.TypeParagraph

    if strExt <> "" then

        objSelection.TypeParagraph

        objSelection.TypeText "Ext=" & vbTab & strExt

    end if 

    if strPhone <> "" then

        objSelection.TypeParagraph    

        objSelection.TypeText "Tel=" & vbTab & strPhone

    end if

    if strFax <> "" then

        objSelection.TypeParagraph

        objSelection.TypeText "Fax=" & vbTab & strFax

    end if

    if strMobile <> "" then

        objSelection.TypeParagraph

        objSelection.TypeText "Mob=" & vbTab & strMobile

    end if

    objDoc.Characters.Last.Select

    objSelection.Collapse

    objSelection.Font.Size = 5

    objSelection.TypeParagraph

    objDoc.Characters.Last.Select

    objSelection.Collapse

    Set objRange = objSelection.Range

    set objTable = objDoc.Tables.Add(objRange,1,1,wdWord8TableBehavior)

    objTable.Columns(1).Width = CentimetersToPoints(3.2)

    objSelection.Font.Color = 2108888

    objSelection.Font.Name = "Arial Black"

    objSelection.Font.Size = 30

    objSelection.TypeText "wl"

    objSelection.Font.Name = "Arial"

    objSelection.Font.Color = 5921370

    objSelection.TypeText "mg"

    objSelection.EndKey Unit = wdLine

    objSelection.InsertColumnsRight

    objTable.Columns(2).Width = CentimetersToPoints(5.4)

    objSelection.Font.Name = "Arial Black"

    objSelection.Font.Size = 11

    objSelection.Font.Color = 2108888

    objSelection.TypeText "West London"

    objSelection.Font.Name = "Arial"

    objSelection.Font.Color = 5921370

    objSelection.TypeText " Motor Group "

    objSelection.Font.Size = 7

    objSelection.ParagraphFormat.Alignment = wdAlignParagraphJustify

    objSelection.TypeText "Eastcote "

    objSelection.Font.Color = 2108888

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText "|"

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 5921370

    objSelection.TypeText " Hanwell "

    objSelection.Font.Color = 2108888

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText "|"

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 5921370

    objSelection.TypeText " High Wycombe "

    objSelection.Font.Color = 2108888

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText "|"

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 5921370

    objSelection.TypeText " Mill Hill Ruislip "

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 2108888

    objSelection.TypeText "|"

    objSelection.Font.Color = 5921370

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText " Shepperton "

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 2108888

    objSelection.TypeText "|"

    objSelection.Font.Color = 5921370

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText " Slough "

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 2108888

    objSelection.TypeText "| "

    objSelection.Font.Color = 5921370

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText "Wooburn Moor"

    objSelection.MoveLeft Unit = wdWord, Count=22

    objSelection.MoveLeft Unit = wdCharacter, Count=4, Extend=wdExtend

    With objSelection.ParagraphFormat

        .LineSpacingRule = wdLineSpaceMultiple

        .LineSpacing = LinesToPoints(0.8)

    End With

    objDoc.Characters.Last.Select

    objSelection.Collapse

    objSelection.Font.Size = 5

    objSelection.TypeParagraph

    objDoc.Characters.Last.Select

    objSelection.Collapse

    Set objRange = objSelection.Range

    set objTable = objDoc.Tables.Add(objRange,1,1,wdWord8TableBehavior)

    objTable.Columns(1).Width = CentimetersToPoints(8.6)

    objSelection.Font.Grow

    objSelection.Font.Color = -603930625

    objSelection.TypeText "The contents of this email, including any attachments, are i"

    objSelection.TypeText "ntended solely for the addressee(s). If you are not the inte"

    objSelection.TypeText "nded recipient of this message, please delete it immediately"

    objSelection.TypeText " and inform the sender of the error. Any use, distribution, "

    objSelection.TypeText "disclosure, copying or printing of this message by anyone ot"

    objSelection.TypeText "her than the intended recipient is strictly prohibited. Alth"

    objSelection.TypeText "ough Hanif Automotive have taken reasonable steps to ensure "

    objSelection.TypeText "that this message is free from malicious code, no liability "

    objSelection.TypeText "is accepted for loss or damage as a result of this message o"

    objSelection.TypeText "r its contents. Hanif Automotive accepts no legal liability "

    objSelection.TypeText "for the content of this communication. The views and opinion"

    objSelection.TypeText "s expressed herein are those of the sender and do not necess"

    objSelection.TypeText "arily reflect those of the company. Hanif Automotive may mon"

    objSelection.TypeText "itor the content of emails transmitted on its network for se"

    objSelection.TypeText "curity reasons. Hanif Automotive Ltd. is registered in Engla"

    objSelection.TypeText "nd, No. 3232373. VAT No. 681 4517 27. Registered Office: 117" 

    objSelection.TypeText " Boston Road, Hanwell, London W7 3SB."

    objSelection.ParagraphFormat.Alignment = wdAlignParagraphJustify

    objSelection.WholeStory

    objSelection.Borders(wdBorderTop).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderRight).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
 
 

Set objSelection = objDoc.Range()
 

objSignatureEntries.Add "WLMG Signature", objSelection

objSignatureObject.NewMessageSignature = "WLMG Signature"

objSignatureObject.ReplyMessageSignature = "WLMG Signature"
 

objDoc.Saved = True

objWord.Quit

Open in new window

0
Comment
Question by:silent_waters
  • 4
  • 2
6 Comments
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 22603302
Hi, try changing each instance of
.... = CentimetersToPoints(x.x)

to
... = objWord.CentimetersToPoints(x.x)

Regards,

Rob.
0
 

Author Closing Comment

by:silent_waters
ID: 31501302
You are the man.
0
 

Author Comment

by:silent_waters
ID: 22606232
Another minor issue, which I hope will be just as easy to solve:
Why doesn't this code, when placed at the end of the script above, Justify everything?

objSelection.WholeStory
objSelection.ParagraphFormat.Alignment = wdAlignParagraphCenter

I can create a new question if necessary, ~i was just hoping it was a simple one.
Is there any online reource where i can teach myself about this stuff? I'm using trial and error and the Word Object model reference on Microsofts site at the moment.
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 65

Expert Comment

by:RobSampson
ID: 22609795
Hi, actually, I'm surprised this worked somewhat well at all.....now that I look at it....

On most of your lines, you use constant values that start with wd, such as wdLineStyleNone, wdWord8TableBehaviour, etc.

Microsoft Word knows what these constant values are, but VBScript does not.  For example, in Word VBA, when you execute MsgBox wdLineSpaceSingle, you get 0.  When using such a value name in VBScript, you need to have at the top
Const wdLineSpaceSingle = 0

So, I have now added all of those constants that you use, to your code, and your alignment should work.  See here for a full reference:
http://msdn.microsoft.com/en-us/library/aa211923(office.11).aspx

Also note, that in a lines such as these:
    objSelection.MoveLeft Unit = wdWord, Count=22
    objSelection.MoveLeft Unit = wdCharacter, Count=4, Extend=wdExtend

you cannot use Count=4 or Extend=wdExtend.  Just remove the <propertyname>= part:
    objSelection.MoveLeft wdWord, 22
    objSelection.MoveLeft wdCharacter, 4, wdExtend

Also, for testing, comment out the On Error Resume Next.  That way, you'll know that things like the above don't work, and you'll be able to correct them.

As far as learning Word automation yourself, the best way that I know how is to record a macro in Word, do what you want to achieve, then modify the created code to suit VBScript automation.

Regards,

Rob.
On Error Resume Next

 

Set objSysInfo = CreateObject("ADSystemInfo")

 

strUser = objSysInfo.UserName

Set objUser = GetObject("LDAP://" & strUser)

 

strName = objUser.FullName

strTitle = objUser.Title

strAddress = objUser.streetAddress

strCity = objUser.l

strState = objUser.st

strPostCode = objUser.PostalCodes

strExt = objUser.TelephonePager

strPhone = objUser.telephoneNumber

strFax = objUser.faxnumber

strMobile = objUser.TelephoneMobile

 

Set objWord = CreateObject("Word.Application")

Const wdLineSpaceSingle = 0

Const wdWord8TableBehavior = 0

Const wdLine = 5

Const wdAlignParagraphJustify = 3

Const wdToggle = 9999998

Const wdWord = 2

Const wdCharacter = 1

Const wdExtend = 1

Const wdLineSpaceMultiple = 5

Const wdBorderTop = -1

Const wdBorderLeft = -2

Const wdBorderBottom = -3

Const wdBorderRight = -4

Const wdBorderHorizontal = -5

Const wdBorderVertical = -6

Const wdBorderDiagonalDown = -7

Const wdBorderDiagonalUp = -8

Const wdLineStyleNone = 0

Const wdAlignParagraphCenter = 1
 

Set objDoc = objWord.Documents.Add()

Set objSelection = objWord.Selection

 

Set objEmailOptions = objWord.EmailOptions

Set objSignatureObject = objEmailOptions.EmailSignature

 

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

 

    objSelection.ParagraphFormat.SpaceBefore=0

    objSelection.ParagraphFormat.SpaceAfter=0

    objSelection.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle

    Set objRange = objSelection.Range

    Set objTable = objDoc.Tables.Add(objRange,1,1,wdWord8TableBehavior)

    objTable.Columns(1).Width = CentimetersToPoints(8.6)

    objSelection.Font.Name = "Verdana"

    objSelection.Font.Size = 10

    objSelection.Font.Color = 2108888

    objSelection.TypeText "_______________________"

    objSelection.TypeParagraph

    objSelection.Font.Bold = True

    objSelection.Font.Color = -587137025

    objSelection.TypeText strName

    objSelection.Font.Color = -603946753

    objSelection.TypeParagraph

    objSelection.Font.Bold = False

    objSelection.TypeText strTitle

    objSelection.Font.Size = 5

    objSelection.TypeParagraph

    objSelection.TypeParagraph

    objSelection.Font.Size = 8

    objSelection.TypeText strAddress

    objSelection.TypeParagraph

    objSelection.TypeText strCity

    objSelection.TypeParagraph

    objSelection.TypeText strState

    objSelection.TypeParagraph

    objSelection.TypeText strPostCode

    objSelection.TypeParagraph

    if strExt <> "" then

        objSelection.TypeParagraph

        objSelection.TypeText "Ext=" & vbTab & strExt

    end if 

    if strPhone <> "" then

        objSelection.TypeParagraph    

        objSelection.TypeText "Tel=" & vbTab & strPhone

    end if

    if strFax <> "" then

        objSelection.TypeParagraph

        objSelection.TypeText "Fax=" & vbTab & strFax

    end if

    if strMobile <> "" then

        objSelection.TypeParagraph

        objSelection.TypeText "Mob=" & vbTab & strMobile

    end if

    objDoc.Characters.Last.Select

    objSelection.Collapse

    objSelection.Font.Size = 5

    objSelection.TypeParagraph

    objDoc.Characters.Last.Select

    objSelection.Collapse

    Set objRange = objSelection.Range

    set objTable = objDoc.Tables.Add(objRange,1,1,wdWord8TableBehavior)

    objTable.Columns(1).Width = CentimetersToPoints(3.2)

    objSelection.Font.Color = 2108888

    objSelection.Font.Name = "Arial Black"

    objSelection.Font.Size = 30

    objSelection.TypeText "wl"

    objSelection.Font.Name = "Arial"

    objSelection.Font.Color = 5921370

    objSelection.TypeText "mg"

    objSelection.EndKey Unit = wdLine

    objSelection.InsertColumnsRight

    objTable.Columns(2).Width = CentimetersToPoints(5.4)

    objSelection.Font.Name = "Arial Black"

    objSelection.Font.Size = 11

    objSelection.Font.Color = 2108888

    objSelection.TypeText "West London"

    objSelection.Font.Name = "Arial"

    objSelection.Font.Color = 5921370

    objSelection.TypeText " Motor Group "

    objSelection.Font.Size = 7

    objSelection.ParagraphFormat.Alignment = wdAlignParagraphJustify

    objSelection.TypeText "Eastcote "

    objSelection.Font.Color = 2108888

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText "|"

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 5921370

    objSelection.TypeText " Hanwell "

    objSelection.Font.Color = 2108888

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText "|"

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 5921370

    objSelection.TypeText " High Wycombe "

    objSelection.Font.Color = 2108888

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText "|"

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 5921370

    objSelection.TypeText " Mill Hill Ruislip "

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 2108888

    objSelection.TypeText "|"

    objSelection.Font.Color = 5921370

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText " Shepperton "

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 2108888

    objSelection.TypeText "|"

    objSelection.Font.Color = 5921370

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText " Slough "

    objSelection.Font.Bold = wdToggle

    objSelection.Font.Color = 2108888

    objSelection.TypeText "| "

    objSelection.Font.Color = 5921370

    objSelection.Font.Bold = wdToggle

    objSelection.TypeText "Wooburn Moor"

    objSelection.MoveLeft wdWord, 22

    objSelection.MoveLeft wdCharacter, 4, wdExtend

    With objSelection.ParagraphFormat

        .LineSpacingRule = wdLineSpaceMultiple

        .LineSpacing = LinesToPoints(0.8)

    End With

    objDoc.Characters.Last.Select

    objSelection.Collapse

    objSelection.Font.Size = 5

    objSelection.TypeParagraph

    objDoc.Characters.Last.Select

    objSelection.Collapse

    Set objRange = objSelection.Range

    set objTable = objDoc.Tables.Add(objRange,1,1,wdWord8TableBehavior)

    objTable.Columns(1).Width = CentimetersToPoints(8.6)

    objSelection.Font.Grow

    objSelection.Font.Color = -603930625

    objSelection.TypeText "The contents of this email, including any attachments, are i"

    objSelection.TypeText "ntended solely for the addressee(s). If you are not the inte"

    objSelection.TypeText "nded recipient of this message, please delete it immediately"

    objSelection.TypeText " and inform the sender of the error. Any use, distribution, "

    objSelection.TypeText "disclosure, copying or printing of this message by anyone ot"

    objSelection.TypeText "her than the intended recipient is strictly prohibited. Alth"

    objSelection.TypeText "ough Hanif Automotive have taken reasonable steps to ensure "

    objSelection.TypeText "that this message is free from malicious code, no liability "

    objSelection.TypeText "is accepted for loss or damage as a result of this message o"

    objSelection.TypeText "r its contents. Hanif Automotive accepts no legal liability "

    objSelection.TypeText "for the content of this communication. The views and opinion"

    objSelection.TypeText "s expressed herein are those of the sender and do not necess"

    objSelection.TypeText "arily reflect those of the company. Hanif Automotive may mon"

    objSelection.TypeText "itor the content of emails transmitted on its network for se"

    objSelection.TypeText "curity reasons. Hanif Automotive Ltd. is registered in Engla"

    objSelection.TypeText "nd, No. 3232373. VAT No. 681 4517 27. Registered Office: 117" 

    objSelection.TypeText " Boston Road, Hanwell, London W7 3SB."

    objSelection.ParagraphFormat.Alignment = wdAlignParagraphJustify

    objSelection.WholeStory

    objSelection.Borders(wdBorderTop).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderRight).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone

    objSelection.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone

 

 

Set objSelection = objDoc.Range()

 

objSignatureEntries.Add "WLMG Signature", objSelection

objSignatureObject.NewMessageSignature = "WLMG Signature"

objSignatureObject.ReplyMessageSignature = "WLMG Signature"

 

objSelection.WholeStory

objSelection.ParagraphFormat.Alignment = wdAlignParagraphCenter
 

objDoc.Saved = True

objWord.Quit

Open in new window

0
 

Author Comment

by:silent_waters
ID: 22609947
Wow, thanks very much for that, you certainly earned your points!
It seems strange though that it worked at all, it seems like either all the constants should work or none of them. Also the Count=4 etc. bits worked fine too! Who knows what goes on at Microsoft?!
Thats really helpful though, I feel like I understand a lot more about the difference / relationship between VBA and VBS now. I'll give it a try in the morning.
Much obliged,
Mark



0
 

Author Comment

by:silent_waters
ID: 22613096
FYI, all working perfectly now.
Thanks again.
0

Featured Post

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Join & Write a Comment

Suggested Solutions

When it comes to writing scripts for a Client/Server computing environment it is essential to consider some way of enabling the authentication functionality within a script. This sort of consideration mainly comes into the picture when we are dealin…
Restoring deleted objects in Active Directory has been a standard feature in Active Directory for many years, yet some admins may not know what is available.
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now