Não tive tempo de ler o código, mas vou dar uma ideia que utilizei ha uns meses:

- uma vez já selecionada a conta, dê o comando para criar um email novo
- capture todo o texto já existente neste email novo recém criado
- feche o email sem enviá-lo ou salvá-lo no rascunho

[/list:u:1dyujq38]
O email novo, recém criado, já vem com a assinatura padrão da conta selecionada
Então a sua variável Assinatura já teria a assinatura corretam deixando assim para o Outlook o trabalho de escolher a assinatura!

No meu caso, funcionou perfeitamente!

 

Ola desculpe a demora, mas assim eu nao quero, eu queria ja fazer pela Macro, por isso postei a Macro inteira,
Gostaria que alguem pudesse completar o codigo com este pedido que faço, ou seja, eu tenho 3 assinaturas no meu Outlock e conforme a assinatura escolhida gostaria que o email fosse enviado com a assinatura de acordo com a conta escolhida.

Andre

Boa noite, fazerbem.

Não cheguei olhar seu código, mas creio que esses links irão lhe dar o norte.

http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=17468
http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=18656

Qualquer coisa avisa ai!

Nao sei ainda o motivo, mas no codigo aqui postado, consigo selecionar a conta de email, mas infelizmente a assinatura que esta relacionada a tal conta o codigo nao traz. Ele traz a assinatura que esta como padrao somente em ( Escolha a assinatura padrao em novas mensagens)

Boa tarde,

Dê uma olhada nesse site http://www.rondebruin.nl/win/s1/outlook/signature.htm.
Creio que, se você criar uma condição não de certo.

Outra coisa eu não encontrei o local onde carrega assinatura no código postado.

Minha Macro ja esta fazendo o passo 1 do topico. A tela pisca e tudo mais, pega a assinatura com imagem etc .

So tem um problema, eu tenho 4 tipos de assinatura que uso , pois trabalho com vendas, Dai a MAcro abaixo esta escolhendo de forma certa qual conta inclusive será usada no envio da mensagem, porem a assinatura esta sendo pega aquela que esta na escolha da assinatura padrao para novas mensagens, dentro da tela do outloock, assinaturas e papel de carta.
Se eu trocar manuqlmente em novas mensagens a assinatura, dai funciona, mas quero fazer isso atraves da Macro assim como foi feita na escolha de qual conta sera usada no envio do email.

Acho que agora expliquei da forma certa meu problema aqui.

Alguns dos amigos poderia me ajudar adaptando isso ao codigo abaixo ?

Andre Luiz

Sub X_Lojas()

'  Lojas Gerais


'Setting up the Excel variables.
    Dim OlApp As Outlook.Application
    Dim OlMensagem As Outlook.MailItem
    Dim iCounter    As Integer
    Dim Dest        As Variant
    Dim SDest       As String
    Dim Estado      As String
    Dim BuscaEstado As Range
    Dim AbrevEstado As String
    Dim Leitura     As String
    Dim contaEmail As String
    Dim idEmail As Integer
    Dim strbody As String
    Dim Loja        As String
    Loja = Range("A1")
    Dim Assunto     As String
    Assunto = Range("L1")
        
    
strbody = "<H2>" & _
        Sheets("Mensagens").Range("B3").Value & _
        "</H2>" & _
        "<H3 style='color: #870c0c'>" & _
        Sheets("Mensagens").Range("B4").Value & _
        "</H3>" & _
        "<H3>" & _
        Sheets("Mensagens").Range("B5").Value & _
        "<br><br>" & _
        Sheets("Mensagens").Range("B6").Value & _
        "<br><br>" & _
        Sheets("Mensagens").Range("B7").Value & _
        "<br><br>" & _
        Sheets("Mensagens").Range("B8").Value & _
        "<br><br>" & _
        Sheets("Mensagens").Range("B9").Value & _
        "<br><br>" & _
        Sheets("Mensagens").Range("B10").Value & _
        "<br><br>" & _
        Sheets("Mensagens").Range("B11").Value & _
        "<br><br>" & _
        Sheets("Mensagens").Range("B12").Value & _
        "</H3>" & _
        "<br><br><B>Obrigado por ser nosso parceiro, conte comigo!!</B>" & _
        "<br><br>"

    Leitura = Sheets(Loja).Range("I7")
    Estado = Application.Caller
    Application.ScreenUpdating = False
    Sheets(Estado).Visible = True

 Application.DisplayAlerts = False 'desabilite o alerta

    Range("L2").Select

    Set BuscaEstado = ThisWorkbook.ActiveSheet.Range("A3:A30").Find(Estado, LookIn:=xlValues, LookAt:=xlWhole)
    
    If BuscaEstado Is Nothing Then
        MsgBox "Estado não localizado"
        GoTo Fim
    Else
    
        AbrevEstado = ThisWorkbook.Worksheets(Loja).Cells(BuscaEstado.Row, 1).Value
    End If
         
    
' Preste atencao aqui
      contaEmail = ThisWorkbook.Sheets(Loja).Range("I8").Value
    
    'Quero que aqui, ao inves de ter RJ tenha a variavel Estado que vai estar associado ao click na     regiao do mapa.
    ThisWorkbook.Worksheets(AbrevEstado).Select
   
    iCounter = 1
   
    'Create the Outlook application and the empty email.
    Set OlApp = CreateObject("Outlook.Application")
Set OlMensagem = OlApp.CreateItem(0)

'------------------------------------------------------------------------------
   
   'Este laço verifica se o nome da conta w no registro do windows é igual ao valor da célula
    For w = 1 To OlApp.Session.Accounts.Count
        If OlApp.Session.Accounts.Item(w).DisplayName = contaEmail Then 'Se for verdadeiro, solicita confirmação
            If MsgBox("O E-mail será enviado usando a conta " & contaEmail & ". Confirma ?" & "    ( Estado - " & Estado & " )", vbQuestion + vbYesNo, "Envio de e-mail") = vbYes Then
                            
                idEmail = w 'Define o id da conta para o comando enviar
                Exit For 'Sai do laço
                
            Else
                 Sheets(Estado).Visible = False
                 Sheets(Loja).Select
                
                GoTo Fim 'Senão sai da rotina
            End If
        End If
    Next
'-------------------------------------------------------------------------------
'Using the email, add multiple recipients, using a list of addresses in column C.
     With OlMensagem
       For iCounter = 1 To WorksheetFunction.CountA(Columns(3))
       
       ' Sheets("Email").Select
               SDest = SDest & ";" & Cells(iCounter, 3).Value
       Next iCounter
                    
          
    'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
       .Display
       .BCC = SDest
       .Subject = Assunto '"Tabela de Pedidos"
       .HTMLBody = strbody & "<br>" & .HTMLBody
       
If Sheets(Loja).Range("F1").Value > 0 Then
       .Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets(Loja).Range("F1").Value & Sheets(Loja).Range("I1").Value
Else
    End If

If Sheets(Loja).Range("F2").Value > 0 Then
       .Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets(Loja).Range("F2").Value & Sheets(Loja).Range("I2").Value
Else
    End If
If Sheets(Loja).Range("F3").Value > 0 Then
       .Attachments.Add "C:UsersAndreDesktopPedidos GauerBanner" & Sheets(Loja).Range("F3").Value & Sheets(Loja).Range("I3").Value
Else
    End If
If Sheets(Loja).Range("F4").Value > 0 Then
       .Attachments.Add "C:UsersAndreDesktopPedidos GauerBanner" & Sheets(Loja).Range("F4").Value & Sheets(Loja).Range("I4").Value
Else
    End If
       
       
If Sheets(Loja).Range("I6").Value = "SEND" Then
       .ReadReceiptRequested = Leitura ' confirmação de leitura
       .SendUsingAccount = OlApp.Session.Accounts.Item(idEmail)
       .Send
Else

       .ReadReceiptRequested = Leitura ' confirmação de leitura
       .SendUsingAccount = OlApp.Session.Accounts.Item(idEmail)
       .Display
        
End If

Sheets(Loja).Select
Sheets(Estado).Visible = False
   
GoTo Fim

   End With

    Exit Sub
Fim:
   'Clean up the Outlook application.
   Set BuscaEstado = Nothing
   Set OlMensagem = Nothing
   Set OlApp = Nothing
   
   
End Sub

falta so essa ! alguem se habilita a me ajudar ?

Sei que sim, grato

Andre