3

Para enviar e-mails uso a função SendEmail:

function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;
type
  TAttachAccessArray = array [0..0] of TMapiFileDesc;
  PAttachAccessArray = ^TAttachAccessArray;
var
  MapiMessage: TMapiMessage;
  Receip, ComCopia: TMapiRecipDesc;
  Attachments: PAttachAccessArray;
  AttachCount: Integer;
  i1: integer;
  FileName: string;
  dwRet: Cardinal;
  MAPI_Session: Cardinal;
  WndList: Pointer;

  aRecep: Array of TMapiRecipDesc;
  iRecipC, iCont: Integer;
  sAuxCCo, sCCo, sTO: String;
begin
  dwRet := MapiLogon(Handle, PAnsiChar(''), PAnsiChar(''), MAPI_LOGON_UI or MAPI_NEW_SESSION, 0, @MAPI_Session);
  if (dwRet <> SUCCESS_SUCCESS) then
  begin
    MessageBox(Handle, PChar('Error while trying to send email'#10+SysErrorMessage(GetLastError)), PChar('Error'), MB_ICONERROR or MB_OK);
  end
  else
  begin
    AttachCount := 0;
    Attachments := nil;
    try
      FillChar(MapiMessage, SizeOf(MapiMessage), #0);
      FillChar(Receip, SizeOf(Receip), #0);
      FillChar(ComCopia, SizeOf(ComCopia), #0);

      iRecipC := 0;
      if Mail.Values['to'] <> '' then
      begin
        sAuxCCo := Mail.Values['to'];
        if (sAuxCCo[Length(sAuxCCo)] <> ';') then
          sAuxCCo := sAuxCCo + ';';
        while (Pos(';',sAuxCCo)) > 0 do
        begin
          sTO := sTO + Copy(sAuxCCo,1,Pos(';',sAuxCCo));
          Delete(sAuxCCo,1,Pos(';',sAuxCCo));
          Inc(iRecipC);
        end;
      end;

      if Mail.Values['CCo'] <> '' then
      begin
        sAuxCCo := Mail.Values['CCo'];
        if (sAuxCCo[Length(sAuxCCo)] <> ';') then
          sAuxCCo := sAuxCCo + ';';
        while (Pos(';',sAuxCCo)) > 0 do
        begin
          sCCo := sCCo + Copy(sAuxCCo,1,Pos(';',sAuxCCo));
          Delete(sAuxCCo,1,Pos(';',sAuxCCo));
          Inc(iRecipC);
        end;
      end;

      SetLength(aRecep, iRecipC);

      iCont := 0;
      if sTO <> '' then
      begin
        while ((sTO) <> '') do
        begin
          sAuxCCo := Copy(sTO,1,Pos(';',sTO)- 1);

          aRecep[iCont].ulReserved   := 0;
          aRecep[iCont].ulRecipClass := MAPI_TO;
          aRecep[iCont].lpszName     := StrNew(PAnsiChar(AnsiString(sAuxCCo)));
          aRecep[iCont].lpszAddress  := StrNew(PAnsiChar(AnsiString('SMTP:' + sAuxCCo)));
          aRecep[iCont].ulEIDSize    := 0;

          Delete(sTO,1,Pos(';',sTO));
          Inc(iCont);
        end;
      end;

      if sCCo <> '' then
      begin
        while ((sCCo) <> '') do
        begin
          sAuxCCo := Copy(sCCo,1,Pos(';',sCCo)- 1);

          aRecep[iCont].ulReserved   := 0;
          aRecep[iCont].ulRecipClass := MAPI_BCC;
          aRecep[iCont].lpszName     := StrNew(PAnsiChar(AnsiString(sAuxCCo)));
          aRecep[iCont].lpszAddress  := StrNew(PAnsiChar(AnsiString('SMTP:' + sAuxCCo)));
          aRecep[iCont].ulEIDSize    := 0;

          Delete(sCCo,1,Pos(';',sCCo));
          Inc(iCont);
        end;
      end;

      AttachCount := 0;

      for i1 := 0 to MaxInt do
      begin
        if Mail.Values['attachment' + IntToStr(i1)] = '' then
          break;
        Inc(AttachCount);
      end;

      if AttachCount > 0 then
      begin
        GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);

        for i1 := 0 to AttachCount - 1 do
        begin
          FileName := Mail.Values['attachment' + IntToStr(i1)];
          Attachments[i1].ulReserved := 0;
          Attachments[i1].flFlags := 0;
          Attachments[i1].nPosition := ULONG($FFFFFFFF);
          Attachments[i1].lpszPathName := StrNew(PAnsiChar(AnsiString(FileName)));
          Attachments[i1].lpszFileName := StrNew(PAnsiChar(AnsiString(ExtractFileName(FileName))));
          Attachments[i1].lpFileType := nil;
        end;
      end;

      with MapiMessage do
      begin
        ulReserved         := 0;
        lpszSubject        := StrNew(PAnsiChar(AnsiString(Mail.Values['subject'])));
        lpszNoteText       := StrNew(PAnsiChar(AnsiString(Mail.Values['body'])));
        lpszMessageType    := Nil;
        lpszDateReceived   := Nil;
        lpszConversationID := Nil;
        flFlags            := 0;
        lpOriginator       := Nil;
        nRecipCount        := iRecipC;
        lpRecips           := @aRecep[0];
        nFileCount         := AttachCount;
        lpFiles            := @Attachments[0];
      end;

      WndList := DisableTaskWindows(0);
      try
        Result := MapiSendMail(MAPI_Session, Handle, MapiMessage, MAPI_DIALOG, 0);
      finally
        EnableTaskWindows( WndList );
      end;
    finally
      for i1 := 0 to AttachCount - 1 do
      begin
        StrDispose(Attachments[i1].lpszPathName);
        StrDispose(Attachments[i1].lpszFileName);
      end;

      if Assigned(MapiMessage.lpszSubject) then
        StrDispose(MapiMessage.lpszSubject);
      if Assigned(MapiMessage.lpszNoteText) then
        StrDispose(MapiMessage.lpszNoteText);
      if Assigned(Receip.lpszAddress) then
        StrDispose(Receip.lpszAddress);
      if Assigned(Receip.lpszName) then
        StrDispose(Receip.lpszName);

      MapiLogOff(MAPI_Session, Handle, 0, 0);
    end;
  end;
end;

Até o Office 2010 ela funciona perfeitamente, mas a partir do Office 2013 não funciona mais. O erro estoura logo após o processamento da primeira linha, gerando a mensagem:

MessageBox(Handle, PChar('Error while trying to send email'#10+SysErrorMessage(GetLastError)), PChar('Error'), MB_ICONERROR or MB_OK);

Alguém sabe como resolver?

16
  • abra o executar do windows e execute: mailto:endereço_e-mail_desejado o que acontece? Commented 9/12/2016 às 16:17
  • @JúniorMoreira Abre o Outlook normalmente, na tela de composição do e-mail.
    – Andrey
    Commented 9/12/2016 às 16:25
  • Ok, isso comprova que o Outlook é o servidor de e-mail padrão do seu pc, então verifique se existe outras versões do Office instalado, se possível Desinstale! E se existir plugins do Excel, remova-os também! Commented 9/12/2016 às 16:37
  • @JúniorMoreira Um detalhe importante, compilei um código que achei em outro site, e ao tentar executa-lo, vem uma mensagem do Windows (não está no código) dizendo que Não há cliente de e-mail padrão. Mas ele está configurado como, já fiz isso dentro do próprio Outlook, por meio das configurações do Windows e ainda da essa mensagem. Aproveitando, tenho apenas essa versão do Office, mas tenho também o LibreOffice.
    – Andrey
    Commented 9/12/2016 às 16:43
  • 1
    Provavelmente sua aplicação Delphi é 32bits e o Outlook instalado é 64. answers.microsoft.com/en-us/msoffice/forum/… Commented 13/12/2016 às 18:01

1 Resposta 1

2

Baseado nos comentários. uma solução alternativa para seu problema, seria rodar um comando shell ou .bat com "mailto:"

Ex.: ShellExecute(0, 'open', 'mailto:', '', nil, SW_HIDE);

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .