?
Solved

VBA script problem - Can't alter table cell widths

Posted on 2008-09-29
6
Medium Priority
?
1,173 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
6 Comments
 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 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
Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

 
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

NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I've always wanted to allow a user to have a printer no matter where they login. The steps below will show you how to achieve just that. In this Article I'll show how to deploy printers automatically with group policy and then using security fil…
With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
NetCrunch network monitor is a highly extensive platform for network monitoring and alert generation. In this video you'll see a live demo of NetCrunch with most notable features explained in a walk-through manner. You'll also get to know the philos…
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses

765 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