Enviar E-Mail Pelo Delphi Usando Outlook

[thiagodarocha]

E ai pessoal beleza?

 

Estou desenvolvendo um modulo dentro do sistema que será necessário enviar e-mail para todos os fornecedores através do sistema desenvolvido em Delphi, detalhe que preciso enviar esses emails usando uma conta configurada no Outlook  pois as mensagens que saírem pelo sistema, deverá também ficar nos itens enviados dentro do outlook.

 

Até cheguei a fazer uns exemplos que chegou a funcionar, porem se o outlook estivesse aberto, caso contrario não vai de jeito nenhum, mesmo criando ele em tempo de execução através de uma variável OleVariant.

 

Alguém já chegou a fazer algo parecido? ou tem ideia de como devo proceder?

 

Desde já agradeço a todos e um feliz 2013 a todos do fórum.

[Jéter Rabelo Ferreira]

Boa tarde.

 

Segue abaixo:

function EnviarEmail(Endereco: String; Assunto: String = ''; Texto: String = '';
  stlAnexo: TStringList = nil; AEnviarDireto: boolean = False): Boolean;
type
  TAttachAccessArray = array [0..0] of TMapiFileDesc;
  PAttachAccessArray = ^TAttachAccessArray;
var
  MapiMessage: TMapiMessage;
  MError: Cardinal;
  Sender: TMapiRecipDesc;
  PRecip, Recipients: PMapiRecipDesc;

  Attachments: PAttachAccessArray;
  x: integer;
begin
  Result := False;
  MapiMessage.nRecipCount := 1;
  GetMem( Recipients, MapiMessage.nRecipCount * Sizeof(TMapiRecipDesc) );
  Attachments := nil;

  try
    with MapiMessage do
    begin 
      { Assunto e Texto }
      ulReserved := 0;
      lpszSubject :=  PAnsichar(PChar( Assunto ));
      lpszNoteText := PAnsichar(PChar( Texto ));

      lpszMessageType := nil;
      lpszDateReceived := nil;
      lpszConversationID := nil;
      flFlags := 0;
      Sender.ulReserved := 0;
      Sender.ulRecipClass := MAPI_ORIG;
      Sender.lpszName := PAnsichar(PChar( '' ));
      Sender.lpszAddress := PAnsichar(PChar( '' ));
      Sender.ulEIDSize := 0;
      Sender.lpEntryID := nil;
      lpOriginator := @Sender;  

      { Endereço }
      PRecip := Recipients;
      PRecip^.ulReserved := 0;
      PRecip^.ulRecipClass := MAPI_TO;
 
      PRecip^.lpszName := PAnsichar(PChar( Endereco ));
      PRecip^.lpszAddress := StrNew( PAnsichar(PChar('SMTP:' + Endereco ) ));

      PRecip^.ulEIDSize := 0;
      PRecip^.lpEntryID := nil;
      //Inc( PRecip );
      lpRecips := Recipients;

      { Anexa os arquivos }
      if stlAnexo = nil then
      begin
        stlAnexo := TStringList.Create;
        stlAnexo.Clear;
      end;

      { Deleta do stlAnexo os arquivos que não existem }
      for x := 0 to stlAnexo.Count - 1 do
        if not FileExists( stlAnexo.Strings[x] ) then
          stlAnexo.Delete(x);

      { Anexa os arquivos }
      if stlAnexo.Count > 0 then
      begin
        GetMem(Attachments, SizeOf(TMapiFileDesc) * stlAnexo.Count);
        for x := 0 to stlAnexo.Count - 1 do
        begin
          Attachments[x].ulReserved := 0;
          Attachments[x].flFlags := 0;
          Attachments[x].nPosition := ULONG($FFFFFFFF);
          Attachments[x].lpszPathName := StrNew( PAnsichar(PChar(stlAnexo.Strings[x]) ));
          Attachments[x].lpszFileName :=
          StrNew( PAnsichar(PChar( ExtractFileName(stlAnexo.Strings[x]) ) ));
          Attachments[x].lpFileType := nil;
        end;
      end
      {endif};
      nFileCount := stlAnexo.Count;
      lpFiles := @Attachments^;
    end;

    { Enviando o e-mail }
    if not AEnviarDireto then
      MError := MapiSendMail(0, Application.Handle, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0)
    else
      MError := MapiSendMail(0, Application.Handle, MapiMessage, MAPI_LOGON_UI or MAPI_NEW_SESSION or MAPI_SENT, 0);

    case MError of
      MAPI_E_USER_ABORT: ;
      { Mostra mensagem que o envio do e-mail foi abortado pelo usuário.
      Portanto, não será mostrado nada }

      SUCCESS_SUCCESS:
      Result := True;
    else
      MessageDlg( 'Ocorreu um erro inesperado!'#13'Código: ' +
      IntToStr(MError), mtError, [mbOk], 0);
    end;
  finally
    PRecip := Recipients;
    StrDispose( PRecip^.lpszAddress );
    //Inc( PRecip );

    FreeMem( Recipients, MapiMessage.nRecipCount * Sizeof(TMapiRecipDesc) );
    for x := 0 to stlAnexo.Count - 1 do
    begin
      StrDispose( Attachments[x].lpszPathName );
      StrDispose( Attachments[x].lpszFileName );
    end;
  end;
end;

Atenciosamente

[claudiojose]

Ola pessoal

No Código acima teria como colocar quando quero mandar email com cópia

[Larry]

Boa tarde,

 

O código acima funciona apenas para enviar e-mail para um destinatário.

Ao informar dois e-mails (separados por ponto e virgula) no parâmetro "endereço" o outlook não envia a mensagem e retorna "Destinatário inválido"

[renato_oda]

Bom dia, descometa a linha abaixo e faça uma estrutura de repetição que dará certo, para deixar o e-mail com cópia na propriedade ulRecipClass, você pode passar qual o tipo (Destinatário, Cópia ou Cópia oculta) não lembro a nomenclatura agora, mas sei que dá, só um detalhe que tive problema utilizando o MAPI foi enviando e-mail para o Hotmail, ia com alguns caracteres que não consegui resolver em Delphi, tive que montar a minha estrutura em C#.

Inc( PRecip );

[Larry]

Bom dia Renato, funcionou com algumas modificações:

 

Tive que mudar o parâmetro "Endereco" para TStringList, os string para ansistring e as linhas:

 

PRecip^.lpszName := PAnsichar(PChar(...
para
PRecip^.lpszName := StrNew(PAnsichar(ansistring(...

 

PRecip^.lpszAddress := StrNew( PAnsichar(PChar(
para
PRecip^.lpszAddress := StrNew(PAnsichar(ansistring(

 

Attachments[x].lpszPathName := StrNew( PAnsichar(PChar(stlAnexo.Strings[x]) ));
Attachments[x].lpszFileName :=
para
Attachments[x].lpszPathName := StrNew( PAnsichar(ansistring(stlAnexo.Strings[x]) ));
Attachments[x].lpszFileName := StrNew( PAnsichar(ansistring( ExtractFileName(stlAnexo.Strings[x]) ) ));

 

 

 

Segue o código completo:

 

function EnviarEmail(Endereco: TStringList; Assunto: ansiString = ''; Texto: ansiString = '';
  stlAnexo: TStringList = nil; AEnviarDireto: boolean = False): Boolean;
type
  TAttachAccessArray = array [0..0] of TMapiFileDesc;
  PAttachAccessArray = ^TAttachAccessArray;
var
  MapiMessage: TMapiMessage;
  MError: Cardinal;
  Sender: TMapiRecipDesc;
  PRecip, Recipients: PMapiRecipDesc;

 

  Attachments: PAttachAccessArray;
  x: integer;
begin
  Result := False;
  MapiMessage.nRecipCount := Endereco.count;
  GetMem( Recipients, MapiMessage.nRecipCount * Sizeof(TMapiRecipDesc) );
  Attachments := nil;

 

  try
    with MapiMessage do
    begin
      { Assunto e Texto }
      ulReserved := 0;
      lpszSubject :=  PAnsichar(PChar( Assunto ));
      lpszNoteText := PAnsichar(PChar( Texto ));

 

      lpszMessageType := nil;
      lpszDateReceived := nil;
      lpszConversationID := nil;
      flFlags := 0;
      Sender.ulReserved := 0;
      Sender.ulRecipClass := MAPI_ORIG;
      Sender.lpszName := PAnsichar(PChar( '' ));
      Sender.lpszAddress := PAnsichar(PChar( '' ));
      Sender.ulEIDSize := 0;
      Sender.lpEntryID := nil;
      lpOriginator := @Sender;

 

      { Endereço }
      PRecip := Recipients;

 

      for x:=0 to Endereco.count-1 do begin
        PRecip^.ulReserved := 0;
        PRecip^.ulRecipClass := MAPI_TO;

 

        PRecip^.lpszName := StrNew(PAnsichar(ansistring( Endereco[x] )));
        PRecip^.lpszAddress := StrNew(PAnsichar(ansistring('SMTP:' + Endereco[x] ) ));

 

        PRecip^.ulEIDSize := 0;
        PRecip^.lpEntryID := nil;

 

        Inc( PRecip );
      end;

 

      lpRecips := Recipients;

 

      { Anexa os arquivos }
      if stlAnexo = nil then
      begin
        stlAnexo := TStringList.Create;
        stlAnexo.Clear;
      end;

 

      { Deleta do stlAnexo os arquivos que não existem }
      x:=0;
      while x <=stlAnexo.Count - 1 do begin
        if not FileExists( stlAnexo.Strings[x] ) then
          stlAnexo.Delete(x)
        else
          inc(x);
      end;

 

      { Anexa os arquivos }
      if stlAnexo.Count > 0 then
      begin
        GetMem(Attachments, SizeOf(TMapiFileDesc) * stlAnexo.Count);
        for x := 0 to stlAnexo.Count - 1 do
        begin
          Attachments[x].ulReserved := 0;
          Attachments[x].flFlags := 0;
          Attachments[x].nPosition := ULONG($FFFFFFFF);
          Attachments[x].lpszPathName := StrNew( PAnsichar(ansistring(stlAnexo.Strings[x]) ));
          Attachments[x].lpszFileName := StrNew( PAnsichar(ansistring( ExtractFileName(stlAnexo.Strings[x]) ) ));
          Attachments[x].lpFileType := nil;
        end;
      end
      {endif};
      nFileCount := stlAnexo.Count;
      lpFiles := @Attachments^;
    end;

 

    { Enviando o e-mail }
    if not AEnviarDireto then
      MError := MapiSendMail(0, Application.Handle, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0)
    else
      MError := MapiSendMail(0, Application.Handle, MapiMessage, MAPI_LOGON_UI or MAPI_NEW_SESSION or MAPI_SENT, 0);

 

    case MError of
      MAPI_E_USER_ABORT: ;
      { Mostra mensagem que o envio do e-mail foi abortado pelo usuário.
      Portanto, não será mostrado nada }

 

      SUCCESS_SUCCESS:
      Result := True;
    else
      MessageDlg( 'Ocorreu um erro inesperado!'#13'Código: ' +
      IntToStr(MError), mtError, [mbOk], 0);
    end;
  finally
    PRecip := Recipients;
    StrDispose( PRecip^.lpszAddress );
    //Inc( PRecip );

 

    FreeMem( Recipients, MapiMessage.nRecipCount * Sizeof(TMapiRecipDesc) );
    for x := 0 to stlAnexo.Count - 1 do
    begin
      StrDispose( Attachments[x].lpszPathName );
      StrDispose( Attachments[x].lpszFileName );
    end;
  end;
end;

 

 

Editado 18 Dezembro, 2015 por Larry

[desenvolvedor2]

Olá!
Estou tendo problemas com essa rotina de envio de e-mail quando escolho não enviar direto e o Outlook já está aberto.
Alguém já passou por problemas nesse contexto?