少し考えて、なぜこれをとかしてはいけないかを説明するためのさらなる神経費を考慮した後、私はこれを行う方が良いと判断しました。
インターネットで大騒ぎしていたので、事前に作成されたテンプレートによる署名実装の例を見つけることができず、自分で彫刻しなければなりませんでした。
私は、これをユーザーからの要求の形で、希望するオブジェクトに属するユーザーのダイアログボックスを介して配置することにしました。 大量のInputBoxを作成しないために、IEポップアップウィンドウからこれを実装することにしました。その後、必要なデータがすべてそこから取得されます。
- ユーザーに必要な情報を要求する
会社は異なるロゴを持つ4つの主要なブランドを使用しているため、ユーザーは選択したブランドに関連して自分のブランドを選択する必要があり、画像はロゴに挿入されます。
リストから位置と単位を選択するには、すべての可能なオプションが事前に記述されているデータリストが使用されます。 （外部ディレクトリファイルを使用してリストから選択を実装する方法を誰かが教えてくれた場合、より良い方法は思いつきませんでした。
また、ブランドのユーザーによってブランドの選択ピースに処理が挿入されました。1つのブランドの単位の形式は私たちにとって異なるため、機関の形式はブランドに応じて選択されます。
' 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
ユーザーからのこのリクエストで、彼から取得できる情報は終了しました。
- メールアドレスを見つける
このスクリプトはOutlookで既にメールが構成されている場所で実行されることを想定しているため、郵送先住所を見つける最も簡単な方法は、ユーザーが自分で入力するのを待たずに、既に構成されている方法を確認することです。
私の意見では、最も単純で最も論理的な方法は、システムにログインしているユーザーのユーザー名を調べ、彼のプロファイルフォルダーを調べ、MAPI経由で接続されたメールボックスのアドレスに相当するOSTファイルの名前を調べることです。
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)
- Outlookの署名生成
必要なデータをすべて収集したら、署名自体の作成に進みます。
テンプレートは2で構成され、新しいメッセージの場合は完全、返信の場合は省略されます。
テンプレートには、ファイルストレージのコーパスから取り出されたいくつかの写真があり、デフォルトでは全員の読み取りアクセス権があります。 そして、そこからすべてのロゴが伸びています。
スクリプトコードのコメント
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
実際には、署名の最終形式は
