deu erro aqui na LInha . Recipients segue o codigo na linha
Nao entendi essa linha , pois antes era .BCC = Sdest é pra ser com copoia oculta mesmo
.Recipients = Sdest
e nem essa linha
.SendUsingAccount = Plan1.Range("D22").Value, pois essa macro esta numa aba MAPA, que ao ser acionada no mapa, por exemplo clicando em AM ( AMazonas ), envia o email a todas as lojas deste Estado, entao em Plan1 coloco o que ? Esta aba Plan 1 aqui nao existe.
E tambem em D22 na lista suspensa eu devo por os emails ou o Informacoes do usuario ( nome da conta ) ?
Sub X_Lojas()
' Lojas da Mundo Verde
'Setting up the Excel variables.
Dim olApp As Outlook.Application
Dim olMensagem As Outlook.MailItem
'Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
Dim Estado As String
Dim BuscaEstado As Range
Dim AbrevEstado As String
Estado = Application.Caller
Sheets(Estado).Visible = True
Set BuscaEstado = ThisWorkbook.ActiveSheet.Range("A3:A29").Find(Estado, LookIn:=xlValues, LookAt:=xlWhole)
If BuscaEstado Is Nothing Then
MsgBox "Estado não localizado"
GoTo Fim
Else
AbrevEstado = ThisWorkbook.Worksheets("MAPA").Cells(BuscaEstado.Row, 1).Value
End If
'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 olMailItm = olApp.CreateItem(0)
Set olMensagem = olApp.CreateItem(0)
'Using the email, add multiple recipients, using a list of addresses in column C.
' With olMailItm
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.
'.BCC = SDest
.Recipients = SDest
.Subject = "Tabela de Pedidos"
'.Body = "Ola"
.Body = "Olá Lojista! Segue anexo nossa Tabela de Pedidos, fico no seu Aguardo." & vbCrLf & _
"" & vbCrLf & _
"Seu Pedido Mímimo é de R$ 600,00, a a forma de envio é F.O.B" & vbCrLf & _
"" & vbCrLf & _
"ATENÇÃO" & vbCrLf & _
"" & vbCrLf & _
"Seu Pedido somente será liberado depois de sua Aprovação, pois encaminharei um esboço do seu pedido por E-Mail." & vbCrLf & _
"" & vbCrLf & _
"Obrigado!" & vbCrLf & _
"" & vbCrLf & _
"André Luiz" & vbCrLf & _
"Fone: (21)3564-2347" & vbCrLf & _
"WhatsApp: (21)98799-3381" & vbCrLf & _
"atendimento-rj@gauerdobrasil.com.br"
'troque o diretorio do documento que queira enviar 'add' anexo.
.Attachments.Add "C:UsersAndreDesktopPedidos GauerLojista Mundo Verde - Gauer do Brasil.xlsx"
' .Display 'Send
.SendUsingAccount = Plan1.Range("D22").Value
Sheets("MAPA").Select
Sheets(Estado).Visible = False
End With
Exit Sub
Fim:
'Clean up the Outlook application.
Set BuscaEstado = Nothing
'Set olMailItm = Nothing
Set olMensagem = Nothing
Set olApp = Nothing
End Sub
Postado : 22/12/2015 12:44 pm