📜 ⬆️ ⬇️

Creating a signature on the template in Outlook for the organization, on computers outside the domain

We have been using MS Exch with AD for a long time in the company, but most of the computers in remote branches are not included in the domain, and just as long ago, our DG was annoyed that the people in the signature use anything, just not accepted by the corporate standard template.

Thinking a little and having estimated the further nerve expenditure on explaining why it cannot be combed, I decided that it was better to do it.

Having rummaged in an Internet did not find examples of implementation of the signature on in advance written template, and it was necessary to sculpt most.
')
I decided to issue this in the form of a request from the user through the dialog box of his belonging to the desired object. In order not to produce a bunch of InputBox decided to implement this through a pop-up window IE, from which all the necessary data is later pulled.


Since the company uses 4 main brands with different logos, the user must select his own, relative to the selected brand, his image will be inserted into the logo.

To select the position and units from the list are used datalist in which all possible options are previously described. (I didn’t think of a better way, if someone tells you how to implement a selection from the list using an external directory file, it will be super.)

Also, processing is inserted in the user selection piece of the brand, since the format of departments in one brand is different for us, depending on the brand, the format of the institution is chosen.

'    Dim objIE Dim Brand Set objIE = CreateObject( "InternetExplorer.Application" ) objIE.Navigate "about:blank" objIE.Document.Title = "  " objIE.ToolBar = False objIE.Resizable = False objIE.StatusBar = False objIE.Width = 600 objIE.Height = 250 Do While objIE.Busy WScript.Sleep 200 Loop objIE.Document.Body.InnerHTML = "<DIV align=""Left""><P>"&_ "<datalist id=""rw""><option></option><option></option></datalist>"&_ "<datalist id=""obj""><option>1</option><option>2</option><option>3</option></datalist>"&_ "<input type='radio' name='RadioOption' value='1'>U "&_ "<input type='radio' name='RadioOption' value='2'>M "&_ "<input type='radio' name='RadioOption' value='3'>C<br>"&_ "<input type='radio' name='RadioOption' value='4'>L<br>"&_ "<input List='rw' name='Dol' ><br>"&_ "<input List='obj' name='objt' ><br>"&_ "<input type='text' name='FIO' > <br>"&_ "<input type='tel' name='tel' >    +7(***)***-**-**<br>"&_ "<input id='OK' type='hidden' value='0' name='OK'>"&_ "<input type='submit' value='OK' onClick='VBScript:OK.Value=1'>" objIE.Visible = True Do While objIE.Document.All.OK.Value = 0 WScript.Sleep 200 Loop If objIE.Document.All.RadioOption(0).checked=true then Brand ="U" If objIE.Document.All.RadioOption(1).checked=true then Brand="M" If objIE.Document.All.RadioOption(2).checked=true then Brand="c" If objIE.Document.All.RadioOption(3).checked=true then Brand="L" If objIE.Document.All.RadioOption(0).checked=true then strCompany="U" If objIE.Document.All.RadioOption(1).checked=true then strCompany="M" If objIE.Document.All.RadioOption(2).checked=true then strCompany="C" If objIE.Document.All.RadioOption(3).checked=true then strCompany="L" If objIE.Document.All.RadioOption(3).checked=true then dolj= objIE.Document.All.Dol.Value+" " else dolj= objIE.Document.All.Dol.Value+" " objtj= objIE.Document.All.objt.Value strMobile = objIE.Document.All.tel.Value strName = objIE.Document.All.FIO.Value objIE.Quit 

On this request from the user information that we can get from him is completed.


Since we assume that this script will run where there is already mail configured in Outlook, the easiest way to find out the email address is to look at how it is already configured, and not to wait for the user to enter it himself, making a mistake a couple of times in points and letters.
The most simple and logical way in my opinion is to find out the username of the user logged in to the system, look into his daddy with the profile and look at the name of the OST file, which is equivalent to the address of the mailbox connected via MAPI.

 On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48) For Each objItem in colItems login_full =objItem.UserName Next Set objItem = Nothing: Set colItems = Nothing: Set objWMIService = Nothing login_find = "\" login_pos = InStr(1,login_full,login_find) login_len = len(login_full) login = right(login_full,login_len-login_pos) folder_find = "C:\Users\"&login&"\AppData\Local\Microsoft\Outlook" Set objShellApp = CreateObject("Shell.Application") Set objFolder = objShellApp.NameSpace(folder_find) Set objFolderItems = objFolder.Items() objFolderItems.Filter 64+128, "*.ost" For Each file in objFolderItems file_name = file Next file_len = len(file_name) strEmail = left(file_name,file_len-4) 


After collecting all the necessary data we proceed to the formation of the signature itself.
The template is formed 2, full for new messages, and short - for answers.
There are several pictures in the template that come from the corpus of the file storage, to which everyone has read access by default. And all the logos are drawn from there.
Script comments on the text of the code

 strZpov = " , " strTitle = dolj+" "+objtj strweb = "www.www.ru" strLogo1 = "\\cabinet\\\"&Brand&"_logo_wl.jpg" '  strLogo3 = "\\cabinet\\\Ins.jpg" '  instagram strLogo2 = "\\cabinet\\\F.JPG" '  facebook strLogo4 = "\\cabinet\\\line.png" '    strLogo5 = "\\cabinet\\\Save_wood.jpg" '    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 Set objRange = objDoc.Range() '          . '       3  , 2    2  objDoc.Tables.Add objRange,3,2 Set objTable = objDoc.Tables(1) objTable.Rows(1).select '  1,  objSelection.Cells.Merge '         objTable.Cell(1, 1).select '  1      objTable.Cell(1, 1).Width = 605 objselection.font.name = "Cambria" objSelection.Font.Size = "10" objSelection.Font.Color = RGB(88,89,91) '       ( , , , , ) '         mailto: objSelection.TypeText strZpov & strName & CHR(11) objSelection.TypeText strTitle & CHR(11) objSelection.Font.Bold = true objSelection.TypeText strCompany & CHR(11) objSelection.Font.Bold = false objSelection.TypeText strMobile & CHR(11) hyp.Range.Font.name = "Cambria" hyp.Range.Font.Size = "10" hyp.Range.Font.Name = "Cambria" Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail,,, strEmail) hyp.Range.Font.Name = "Cambria" hyp.Range.Font.Size = "10" ' 2,  1,      objTable.Cell(2, 1).select objTable.Cell(2, 1).Width = 150 objTable.Cell(2, 1).Text = objSelection.InlineShapes.AddPicture(strLogo1) '  2  2,         objTable.Cell(2, 2).select objselection.font.name = "Cambria" objSelection.Font.Size = "9,5" objSelection.Font.Color = RGB(88,89,91) objSelection.TypeText "111111, ,  1 10, " & CHR(11) '   ,         '   ,    ,   ,     '     ,       strintPhone if (strPhone <> "") then objSelection.TypeText " «», " & strPhone else objSelection.TypeText " «», +7(111)111-11-11" if (strIntPhone <> "") then objSelection.TypeText " . " & strIntPhone & CHR(11) else objSelection.TypeText CHR(11) Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, strWeb,,, strWeb) hyp.Range.Font.Name = "Cambria" hyp.Range.Font.Size = "9,5" objSelection.TypeText CHR(9) set p_f = objSelection.InlineShapes.AddPicture(strLogo2) Set hyp = objSelection.HyperLinks.Add(p_f, "https://www.facebook.com/kremlin/",,,"Image") hyp.Range.Font.Name = "Cambria" hyp.Range.Font.Size = "9,5" objSelection.TypeText " " set p_i = objSelection.InlineShapes.AddPicture(strLogo3) Set hyp = objSelection.HyperLinks.Add(p_i, "https://www.instagram.com/kremlin/",,,"Image") hyp.Range.Font.Name = "Cambria" hyp.Range.Font.Size = "9,5" objselection.font.name = "Cambria" objSelection.Font.Size = "9,5" objSelection.Font.Color = RGB(88,89,91) objSelection.TypeText " @kremlin" objTable.Rows(3).select '  3,        -   objSelection.Cells.Merge objTable.Cell(3, 1).select objTable.Cell(3, 1).Width = 605 objTable.Cell(3, 1).Text = objSelection.InlineShapes.AddPicture(strLogo5) ''' '          outlook    Set objSelection = objDoc.Range() objSignatureEntries.Add "AD Signature", objSelection objSignatureObject.NewMessageSignature = "AD Signature" objDoc.Saved = True objDoc.Close objWord.Quit ''' '             '            '   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 Set objRange = objDoc.Range() objselection.font.name = "Cambria" objSelection.Font.Size = "10" objSelection.Font.Color = RGB(88,89,91) objSelection.TypeText strZpov & strName & CHR(11) objSelection.TypeText strTitle & CHR(11) if (strMobile <> "") then objSelection.TypeText strMobile & " | " if (strPhone <> "") then objSelection.TypeText strPhone else objSelection.TypeText "+7(111)111-11-11" if (strIntPhone <> "") then objSelection.TypeText " . " & strIntPhone & CHR(11) else objSelection.TypeText CHR(11) ''' Set objSelection = objDoc.Range() objSignatureEntries.Add "Short_Signature", objSelection objSignatureObject.ReplyMessageSignature = "Short_Signature" objDoc.Saved = True objDoc.Close objWord.Quit 


Actually, the final form of the signatures is as follows.

Source: https://habr.com/ru/post/354430/


All Articles