VBA Outlook: Inserindo Assinatura programaticamente.

Sua assinatura no MS Outlook pode ser personlaizada via vba. Desse modo, caso trabalhe em diversos cliente, poderá inserir o código abaixo em cada máquina onde utilizar o MS Outlook. Para esta aplicação faz-se necessário as refências mostradas Sub InMySig() ' Author: Date: Contact: ' André Bernardes 02/05/2009 09:15 bernardess@gmail.com ' Insere assinatura. Call InSignature("Bernardes") End Sub Sub InSignature(strSigName As String) ' Author: Date: Contact: ' André Bernardes 02/05/2009 09:15 bernardess@gmail.com ' Atenção ao "Nome da assinatura", este precisa ser igual ao que aparece ' nos menus e caixas de diálogo. Dim objItem As Object Dim objInsp As Outlook.Inspector ' Precisa que a referência ao Microsoft Office Word esteja pronta. Dim objDoc As Word.Document Dim objSel As Word.Selection ' Precisa que a referência ao Microsoft Office esteja pronta. Dim objCB As Office.CommandBar Dim objCBP As Office.CommandBarPopup Dim objCBB As Office.CommandBarButton Dim colCBControls As Office.CommandBarControls On Error Resume Next Set objInsp = Application.ActiveInspector If Not objInsp Is Nothing Then Set objItem = objInsp.CurrentItem If objItem.Class = olMail Then ' Caso o editor seja WordMail. If objInsp.EditorType = olEditorWord Then ' Nesta opção ativa a caixa de diálogo de segurança do Outlook. Set objDoc = objInsp.WordEditor Set objSel = objDoc.Application.Selection If objDoc.Bookmarks("_MailAutoSig") Is Nothing Then objDoc.Bookmarks.Add Range:=objSel.Range, Name:="_MailAutoSig" End If objSel.GoTo What:=wdGoToBookmark, Name:="_MailAutoSig" Set objCB = objDoc.CommandBars("AutoSignature Popup") If Not objCB Is Nothing Then Set colCBControls = objCB.Controls End If Else ' Caso o editor não seja o WordMail. ' Acessa o menu 'Insert | Signature'. Set objCBP = Application.ActiveInspector.CommandBars.FindControl(, 31145) If Not objCBP Is Nothing Then Set colCBControls = objCBP.Controls End If End If End If If Not colCBControls Is Nothing Then For Each objCBB In colCBControls If objCBB.Caption = strSigName Then objCBB.Execute Exit For End If Next End If End If Set objInsp = Nothing Set objItem = Nothing Set objDoc = Nothing Set objSel = Nothing Set objCB = Nothing Set objCBB = Nothing End Sub André Luiz Bernardes A&A - WORK, DON´T PLAY! http://al-bernardes.sites.uol.com.br/ bernardess@gmail.com

Nenhum comentário:

Postar um comentário

diHITT - Notícias