como enviar uma mala direta de emails usando o mapi
Tenho uma função de enviar e-mail usando mapi no delphi 7.
Esta enviando certinho, sem nenhum problema.
function EnviarEMailMalaDireta(const De, Assunto, Texto, Arquivo: string; Para:TStringList; Confirma: Boolean): Integer;
type
TAttachAccessArray = array [0..0] of TMapiFileDesc;
PAttachAccessArray = ^TAttachAccessArray;
var
Msg: TMapiMessage;
lpSender, lpRecepient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
Flags: Cardinal;
begin
// cria propriedades da mensagem
FillChar(Msg, SizeOf(Msg), 0);
with Msg do
begin
if (Assunto <> '') then
lpszSubject := PChar(Assunto);
if (Texto <> '') then
lpszNoteText := PChar(Texto);
// remetente
if (De <> '') then
begin
lpSender.ulReserved := 0;
lpSender.ulRecipClass := MAPI_ORIG;
lpSender.lpszName := PChar(De);
lpSender.lpszAddress := PChar(De);
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := @lpSender;
end;
// destinatário
if (Para.Strings[0] <> '') then
begin
lpRecepient.ulReserved := 0;
lpRecepient.ulRecipClass := MAPI_BCC;
lpRecepient.lpszName := PChar(Para.Strings[0]);
lpRecepient.lpszAddress := PChar('SMTP:'+Para.Strings[0]);
lpRecepient.ulEIDSize := 0;
lpRecepient.lpEntryID := nil;
nRecipCount := 1;
lpRecips := @lpRecepient;
end
else
lpRecips := nil;
// arquivo anexo
if (Arquivo = '') then
begin
nFileCount := 0;
lpFiles := nil;
end
else
begin
FillChar(FileAttach, SizeOf(FileAttach), 0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(Arquivo);
nFileCount := 1;
lpFiles := @FileAttach;
end;
end;
// carrega dll e o método para envio do email
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then
Result := -1
else
begin
try
if Confirma then
Flags := MAPI_DIALOG or MAPI_LOGON_UI
else
Flags := 0;
@SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if @SM <> nil then
Result := SM(0, Application.Handle, Msg, Flags, 0)
else
Result := 1;
finally
FreeLibrary(MAPIModule);
end;
end;
end;
Mas gostaria que ele enviasse para mais de um endereço de e-mail de uma unica vez.
Tenho um grid, que após selecionado os contatos, clico em enviar email...
Ele até carrega os endereços de email no outlook, mas é adicionado varios email, como se fosse 1.
E não envia...
Alguém pode me ajudar por favor?!
Desde já agradeço.
Esta enviando certinho, sem nenhum problema.
function EnviarEMailMalaDireta(const De, Assunto, Texto, Arquivo: string; Para:TStringList; Confirma: Boolean): Integer;
type
TAttachAccessArray = array [0..0] of TMapiFileDesc;
PAttachAccessArray = ^TAttachAccessArray;
var
Msg: TMapiMessage;
lpSender, lpRecepient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
Flags: Cardinal;
begin
// cria propriedades da mensagem
FillChar(Msg, SizeOf(Msg), 0);
with Msg do
begin
if (Assunto <> '') then
lpszSubject := PChar(Assunto);
if (Texto <> '') then
lpszNoteText := PChar(Texto);
// remetente
if (De <> '') then
begin
lpSender.ulReserved := 0;
lpSender.ulRecipClass := MAPI_ORIG;
lpSender.lpszName := PChar(De);
lpSender.lpszAddress := PChar(De);
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := @lpSender;
end;
// destinatário
if (Para.Strings[0] <> '') then
begin
lpRecepient.ulReserved := 0;
lpRecepient.ulRecipClass := MAPI_BCC;
lpRecepient.lpszName := PChar(Para.Strings[0]);
lpRecepient.lpszAddress := PChar('SMTP:'+Para.Strings[0]);
lpRecepient.ulEIDSize := 0;
lpRecepient.lpEntryID := nil;
nRecipCount := 1;
lpRecips := @lpRecepient;
end
else
lpRecips := nil;
// arquivo anexo
if (Arquivo = '') then
begin
nFileCount := 0;
lpFiles := nil;
end
else
begin
FillChar(FileAttach, SizeOf(FileAttach), 0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(Arquivo);
nFileCount := 1;
lpFiles := @FileAttach;
end;
end;
// carrega dll e o método para envio do email
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then
Result := -1
else
begin
try
if Confirma then
Flags := MAPI_DIALOG or MAPI_LOGON_UI
else
Flags := 0;
@SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if @SM <> nil then
Result := SM(0, Application.Handle, Msg, Flags, 0)
else
Result := 1;
finally
FreeLibrary(MAPIModule);
end;
end;
end;
Mas gostaria que ele enviasse para mais de um endereço de e-mail de uma unica vez.
Tenho um grid, que após selecionado os contatos, clico em enviar email...
Ele até carrega os endereços de email no outlook, mas é adicionado varios email, como se fosse 1.
E não envia...
Alguém pode me ajudar por favor?!
Desde já agradeço.
Caroline
Curtidas 0
Respostas
Caroline
24/09/2015
Alguma sugestão de como posso resolver isso? =//
GOSTEI 0
Raimundo Pereira
24/09/2015
Bom dia Carol,
Você pode varrer sua lista de emails e adiciona-los como cópia oculta.
Dá uma olhada no post.
https://www.devmedia.com.br/forum/copia-oculta-email-idsmtp/313148
Você pode varrer sua lista de emails e adiciona-los como cópia oculta.
Dá uma olhada no post.
https://www.devmedia.com.br/forum/copia-oculta-email-idsmtp/313148
GOSTEI 0
Raimundo Pereira
24/09/2015
Só pra lembrar, no seu for da lista de contatos você adiciona os contatos no memo e acrescenta ponto e virgula.
Na hora de enviar .
Você envia para : você mesma .
Cópia Oculta será os contatos do memo.
Na hora de enviar .
Você envia para : você mesma .
Cópia Oculta será os contatos do memo.
GOSTEI 0
Caroline
24/09/2015
Olá P2, muito obrigada pela atenção.
Até esse ponto está, ok. Eu faço a varredura dos emails selecionados, adiciono no memo, com os emails entre ponto e virgula.
Ele abre o outlook com os emails selecionados... Mas aqui esta o problema... na hora de enviar dá o seguinte erro:
Sua mensagem não foi recebida por um ou mais dos destinatários.
Erro de servidor: 'Destinatário inválido'
Está aparecendo isso, porque na hora de abrir os email no outlook, ele mostra todos os emails como se fosse um único e-mail. Um link só.
E na verdade, deveria ser um link para cada endereço de email.
Não sei se deu para compreender. =//
Tem alguma ideia de como posso resolver isso? Já não sei o que fazer. =S
Até esse ponto está, ok. Eu faço a varredura dos emails selecionados, adiciono no memo, com os emails entre ponto e virgula.
Ele abre o outlook com os emails selecionados... Mas aqui esta o problema... na hora de enviar dá o seguinte erro:
Sua mensagem não foi recebida por um ou mais dos destinatários.
Erro de servidor: 'Destinatário inválido'
Está aparecendo isso, porque na hora de abrir os email no outlook, ele mostra todos os emails como se fosse um único e-mail. Um link só.
E na verdade, deveria ser um link para cada endereço de email.
Não sei se deu para compreender. =//
Tem alguma ideia de como posso resolver isso? Já não sei o que fazer. =S
GOSTEI 0
Raimundo Pereira
24/09/2015
Carol, isso acontece por conta de você ter adicionado os contatos em modo oculto como acontece no próprio outlook.
Além dos dentinários que estão no memo você deve colocar um destinatário principal que pode ser você mesmo.
Além dos dentinários que estão no memo você deve colocar um destinatário principal que pode ser você mesmo.
GOSTEI 0
Raimundo Pereira
24/09/2015
Vou ver se acho o modelo que eu estava usando aqui.
GOSTEI 0
Caroline
24/09/2015
Consegui solucionar o meu problema...
vou postar aqui, caso possa ajudar mais pessoas. =D
Precisei mudar o código acima, na parte do destinatário...
ele precisa de um "lpRecips " para cada endereço de e-mail, então criei um array...
na função:
type
TRecipAccessArray = array [0..0] of TMapiRecipDesc;
TlpRecipArray = ^TRecipAccessArray;
//destinatário...
if (Para.Strings[0] = '') then
begin
nRecipCount := 0;
lpRecips := nil;
end
else
begin
Attachments := TlpRecipArray(StrAlloc(Para.Count*SizeOf(TMapiRecipDesc)));
for i:=0 to Para.Count-1 do
begin
Attachments^[i].ulReserved := 0;
Attachments^[i].ulRecipClass := MAPI_BCC;
Attachments^[i].lpszName := StrNew( PChar(NomePara.Strings[i]) );
Attachments^[i].lpszAddress := StrNew( PChar('SMTP:' +Para.Strings[i]) );
Attachments^[i].ulEIDSize := 0;
Attachments^[i].lpEntryID := nil;
end;
nRecipCount := Para.Count;
lpRecips := @Attachments^;
end;
vou postar aqui, caso possa ajudar mais pessoas. =D
Precisei mudar o código acima, na parte do destinatário...
ele precisa de um "lpRecips " para cada endereço de e-mail, então criei um array...
na função:
type
TRecipAccessArray = array [0..0] of TMapiRecipDesc;
TlpRecipArray = ^TRecipAccessArray;
//destinatário...
if (Para.Strings[0] = '') then
begin
nRecipCount := 0;
lpRecips := nil;
end
else
begin
Attachments := TlpRecipArray(StrAlloc(Para.Count*SizeOf(TMapiRecipDesc)));
for i:=0 to Para.Count-1 do
begin
Attachments^[i].ulReserved := 0;
Attachments^[i].ulRecipClass := MAPI_BCC;
Attachments^[i].lpszName := StrNew( PChar(NomePara.Strings[i]) );
Attachments^[i].lpszAddress := StrNew( PChar('SMTP:' +Para.Strings[i]) );
Attachments^[i].ulEIDSize := 0;
Attachments^[i].lpEntryID := nil;
end;
nRecipCount := Para.Count;
lpRecips := @Attachments^;
end;
GOSTEI 0