Avatar of Troy Graham
Troy Graham
Flag for Australia

asked on 

How can I use VBscript to automate Outlook to create a mail rule to add a specific file as an attachment to every outgoing email

I am currently deploying a newly created Outlook signature via a VBS script using a GPO. The script works fine, but is there any way I can create and attach a VCF file as an attachment to all outgoing emails.

The code I am using to deploy the signatures is as follows:

What do I need to add to this code to create and attach a VCF file. If this cannot be done, I am happy just to attach a vcf file that I have created already and stored in C:\vcf folder, but not sure how to do it.

' ----- ExeScript Options Begin -----
' ScriptType: window,activescript,invoker
' DestDirectory: current
' Icon: default
' OutputFile: C:\Users\troy.ECLFUELQUIP\Desktop\Scripts\ECLSignatureNew.exe
' FileVersion: 1.0.0.1
' ProductVersion: 1.0.0.1
' 32Bit: yes
' ----- ExeScript Options End -----

On Error Resume Next 
Set objSysInfo = CreateObject("ADSystemInfo") 
 
' ########### This section connects to Active Directory as the currently logged on user 
 strUser = objSysInfo.UserName
 
Set objUser = GetObject("LDAP://" & strUser)  
 
' ########### This section sets up the variables we want to call in the script (items on the left; whereas the items on the right are the active directory database field names) - ie strVariablename = objuser.ad.databasename 
 
strRegards = "Regards"
strGiven = objuser.givenName 
strSurname = objuser.sn  
strFax = objuser.facsimileTelephoneNumber  
strTitle = objUser.Title 
strDepartment = objUser.Department 
strCompany = objUser.Company 
strPhone = objUser.telephoneNumber 
strMobile = objUser.mobile
strEmail =objuser.mail 
strWeb = objuser.wWWHomePage 
strNotes = objuser.info 
strExt = objuser.ipPhone 
strDDI = objuser.homephone 
strAddress = "Unit 31, 287 Victoria Road"
strCity = objuser.l
strState = objuser.st
strPostcode = objuser.postalCode
strPOBox = objuser.postOfficeBox
strEmailTEXT = "Email: " 
strWebTEXT = " | Web: "
strDisclaimer1 = "IMPORTANT NOTICE:  This is an e-mail from the ECL Group or subsidiary company. We do not accept responsibility for any changes to this email or its attachments or for any attachments made by others, after we have transmitted it."
strDisclaimer2 = "UNAUTHORISED USE:  The contents of this e-mail (including any attachments) may be subject to copyright, legal privilege and are confidential.  Any unauthorised use, distribution or copying of the contents is expressly prohibited.  If you have received this e-mail in error, please advise us by return e-mail or telephone and then delete this e-mail together with all attachments. Views expressed in this communication may not be those of the ECL Group or subsidiaries."
strDisclaimer3 = "VIRUSES:  The ECL Group or subsidiaries do not represent or warrant that this e-mail or files attached to this e-mail are free from computer viruses or other defects.  Any attached files are provided, and may only be used, on the basis that the user assumes all responsibility for any loss, damage or consequence resulting directly or indirectly from their use.  The liability of the ECL Group or subsidiaries is limited in any event to either the resupply of the attached files or the cost of having the attached files resupplied."
strDisclaimer4 = "NOTE: The ECL Group or subsidiaries standard Warranty Statement WS1 and Terms and Conditions of Sale apply to any products or services quoted here. A copy of these conditions can be provided on request or from our website. All prices quoted exclude freight and are subject to exchange rate variations unless specifically stated otherwise"


' ########### Sets up word template 
 
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 
 
' ########### Calls the variables from above section and inserts into word template, also sets initial font typeface, colour etc. 
 
objSelection.Font.Name = "Arial" 
objSelection.Font.Size = 10 
objselection.Font.Bold = false 
objSelection.Font.Color = RGB (000,000,000) 
 
objSelection.TypeParagraph()
objSelection.TypeText strRegards
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.TypeText strGiven & " " & strSurname
objSelection.TypeParagraph()
objSelection.Font.Size = 10 
objselection.Font.Bold = false 
objSelection.TypeText strTitle 
objSelection.TypeParagraph()
objSelection.TypeText strCompany
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.TypeText strAddress & " " & strCity & " " & strState & " " & StrPostcode & " |" & " " & strPOBox
objSelection.TypeParagraph()
objSelection.TypeParagraph()


if strPhone = "" then
	strTel = ""
else
	strTel = "DDI: " & strPhone & " " & "|" & " " & "Fax: " & strFax & " " & "|" & " " & "Mobile: " & strMobile
end if

if strExt <> "" then
 	strTel = strTel  & " | Ext: " & strExt 
end if

objSelection.TypeText strTel 

objSelection.TypeParagraph()
objSelection.TypeText

objselection.TypeText strEmailTEXT 
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail, , , strEmail)
  objLink.Range.Font.Name = "Arial" 
  objLink.Range.Font.Size = 10 
  objLink.Range.Font.Bold = false 
objselection.TypeText strWebTEXT 
 Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, " " & "www.eclgroup.com.au") 
 objSelection.TypeParagraph() 
 
 objSelection.TypeParagraph() 
   
Set objLink = objSelection.Hyperlinks.Add(objSelection.InlineShapes.AddPicture("\\10.2.20.5\ecldata\logos\ecl-logo.jpg"))

' ########### Tells outlook to use this signature for new messages and replys. 
 
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Font.Size = 7.5 
objselection.Font.Bold = false 
objSelection.Font.Color = RGB (128,128,128) 
objSelection.TypeText strDisclaimer1
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.TypeText strDisclaimer2
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.TypeText strDisclaimer3
objSelection.TypeParagraph()



Set objSelection = objDoc.Range() 
objSignatureEntries.Add "ECL Group", objSelection 
Set objWord = CreateObject("Word.Application")
objWord.Visible = false
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
objSignatureObject.NewMessageSignature = "ECL Group"
 
objDoc.Saved = True 
 
objWord.Quit

Open in new window

VB ScriptOutlookActive Directory

Avatar of undefined
Last Comment
Bill Prew

8/22/2022 - Mon