Tente esta rotina, é a que eu uso. Ela abre o e-mail padrão, com os anexos e
tudo.
Obs: Substitua a função msgInformacao por showMessage, ou MessageDlg, ou
MessageBox.
Uses
Classes, Forms, SysUtils, Mapi;
function EnviarEMail( pTo, pCC, pCCo, pAssunto, pTexto: PChar; aFiles: Array Of
PChar ): Cardinal;
var
sTo, sCC, sCCo, sAux : String;
MapiMessage : TMapiMessage;
pRecipiente : PMapiRecipDesc ;
aRecipiente : Array Of TMapiRecipDesc;
aArquivoEnvio : Array of TMapiFileDesc;
i, iRecip, iFiles : Integer;
begin
iRecip := 0;
{ Define destinatários TO
}
sTo := '';
if Length(pTo) > 0 Then begin
sAux := pTo;
if sAux[Length(sAux)] <> ';' Then
sAux := sAux + ';';
while Pos( ';', sAux ) > 0 do begin
Inc( iRecip );
sTo := sTo + Copy( sAux, 1, Pos( ';', sAux ) );
Delete( sAux, 1, Pos( ';', sAux ) );
end;
end;
{ Define destinatários CC
}
sCC := '';
If Length(pCC) > 0 Then begin
sAux := pCC;
If sAux[Length(sAux)] <> ';' Then
sAux := sAux + ';';
while Pos( ';', sAux ) > 0 do begin
Inc( iRecip );
sCC := sCC + Copy( sAux, 1, Pos( ';', sAux ) );
Delete( sAux, 1, Pos( ';', sAux ) );
end;
end;
{ Define destinatários CCo
}
sCCo := '';
If Length(pCCo) > 0 Then begin
sAux := pCCo;
If sAux[Length(sAux)] <> ';' Then
sAux := sAux + ';';
while Pos( ';', sAux ) > 0 do begin
Inc( iRecip );
sCCo := sCCo + Copy( sAux, 1, Pos( ';', sAux ) );
Delete( sAux, 1, Pos( ';', sAux ) );
end;
end;
{ cria o tamanho do array de recipiente
}
SetLength(aRecipiente, iRecip);
I := 0;
{ Define recipientes TO
}
while sTO <> '' do begin
Result := MAPIResolveName( 0, 0, PChar( Copy(sTo, 1, Pos(';', sTo) - 1 ) ),
0, 0, pRecipiente );
{ VERIFICA SE NÃO OCORREU ERROS
}
if (Result <> SUCCESS_SUCCESS) Then begin
case Result Of
MAPI_E_AMBIGUOUS_RECIPIENT : msgInformacao('O destinatário não pode ser
resolvido!!' ).ShowModal;
MAPI_E_FAILURE : msgInformacao('Ocorreram um ou mais erros
não especificados!' ).ShowModal;
MAPI_E_INSUFFICIENT_MEMORY : msgInformacao('Memória insuficiente!!'
).ShowModal;
MAPI_E_NOT_SUPPORTED : msgInformacao('Operação não suportada pelo
sistema de mensagens!').ShowModal;
else
msgInformacao('Erro desconhecido!').ShowModal;
end;
Abort;
end;
aRecipiente[i].ulReserved := pRecipiente.ulReserved;
aRecipiente[i].lpszName := pRecipiente.lpszName;
aRecipiente[i].lpszAddress := pRecipiente.lpszAddress;
aRecipiente[i].ulEIDSize := pRecipiente.ulEIDSize;
aRecipiente[i].lpEntryID := pRecipiente.lpEntryID;
aRecipiente[i].ulRecipClass := MAPI_TO;
delete( sTO, 1, Pos( ';', sTO ) );
Inc( I );
end;
{ Define recipientes CC
}
while sCC <> '' do begin
Result := MAPIResolveName( 0, 0, PChar( Copy( sCC, 1, Pos(';', sCC) - 1 )
), 0, 0, pRecipiente );
{ VERIFICA SE NÃO OCORREU ERROS
}
if (Result <> SUCCESS_SUCCESS) Then begin
case Result Of
MAPI_E_AMBIGUOUS_RECIPIENT : msgInformacao('O destinatário não pode ser
resolvido!!' ).ShowModal;
MAPI_E_FAILURE : msgInformacao('Ocorreram um ou mais erros
não especificados!' ).ShowModal;
MAPI_E_INSUFFICIENT_MEMORY : msgInformacao('Memória insuficiente!!'
).ShowModal;
MAPI_E_NOT_SUPPORTED : msgInformacao('Operação não suportada pelo
sistema de mensagens!').ShowModal;
else
msgInformacao('Erro desconhecido!').ShowModal;
end;
Abort;
end;
aRecipiente[i].ulReserved := pRecipiente.ulReserved;
aRecipiente[i].lpszName := pRecipiente.lpszName;
aRecipiente[i].lpszAddress := pRecipiente.lpszAddress;
aRecipiente[i].ulEIDSize := pRecipiente.ulEIDSize;
aRecipiente[i].lpEntryID := pRecipiente.lpEntryID;
aRecipiente[i].ulRecipClass := MAPI_CC;
delete( sCC, 1, Pos( ';', sCC ) );
inc( I );
end;
{ Define recipientes BCC
}
while sCCo <> '' do begin
Result := MAPIResolveName( 0, 0, PChar( Copy( sCCo, 1, Pos(';', sCCo) - 1 )
), 0, 0, pRecipiente );
{ VERIFICA SE NÃO OCORREU ERROS
}
if (Result <> SUCCESS_SUCCESS) Then begin
case Result Of
MAPI_E_AMBIGUOUS_RECIPIENT : msgInformacao('O destinatário não pode ser
resolvido!!' ).ShowModal;
MAPI_E_FAILURE : msgInformacao('Ocorreram um ou mais erros
não especificados!' ).ShowModal;
MAPI_E_INSUFFICIENT_MEMORY : msgInformacao('Memória insuficiente!!'
).ShowModal;
MAPI_E_NOT_SUPPORTED : msgInformacao('Operação não suportada pelo
sistema de mensagens!').ShowModal;
else
msgInformacao('Erro desconhecido!').ShowModal;
end;
Abort;
end;
aRecipiente[i].ulReserved := pRecipiente.ulReserved;
aRecipiente[i].lpszName := pRecipiente.lpszName;
aRecipiente[i].lpszAddress := pRecipiente.lpszAddress;
aRecipiente[i].ulEIDSize := pRecipiente.ulEIDSize;
aRecipiente[i].lpEntryID := pRecipiente.lpEntryID;
aRecipiente[i].ulRecipClass := MAPI_BCC;
delete( sCCo, 1, Pos( ';', sCCo ) );
Inc( I );
end;
//
iFiles := Length( aFiles );
{ cria o tamanho do array de anexos
}
SetLength(aArquivoEnvio, iFiles);
{ indica os parâmetros para cada recepiente de anexos
}
for I := 0 To High(aArquivoEnvio) do begin
aArquivoEnvio[i].ulReserved := 0;
aArquivoEnvio[i].flFlags := 0;
aArquivoEnvio[i].nPosition := 0;
aArquivoEnvio[i].lpszPathName := aFiles[I];
aArquivoEnvio[i].lpszFileName := Nil;
aArquivoEnvio[i].lpFileType := Nil;
end;
{ configura o MapiMessage para ser usando pelo MapiSendMail
}
with MapiMessage do begin
ulReserved := 0;
lpszSubject := pAssunto;
lpszNoteText := pTexto;
lpszMessageType := 'HTML';
lpszDateReceived := Nil;
lpszConversationID := Nil;
flFlags := 0;
lpOriginator := Nil;
nRecipCount := iRecip;
lpRecips := @aRecipiente[0];
nFileCount := iFiles;
lpFiles := @aArquivoEnvio[0];
end;
{ ativo o e-mail usado pelo usuário e coloca o destinatário, Assunto,corpo do
e-mail e anexos
}
Result := MapiSendMail(0, Application.Handle, MapiMessage, MAPI_DIALOG or
MAPI_LOGON_UI or MAPI_NEW_SESSION, 0);
{ caso você queira que não seja ativado o e-mail, apenas enviando a mensagem
use a
linha abaixo no lugar da linha acima.
}
// Result := MapiSendMail( 0, 0, MapiMessage, 0, 0 );
If Result <> 0 Then
msgInformacao('Erro no envio').ShowModal;
{ libera a memória alocada para o Recipiente
}
MAPIFreeBuffer( pRecipiente );
end;
Jefferson Bompadre
cel: (11) 7165-4146
[EMAIL PROTECTED]
[EMAIL PROTECTED]
----- Original Message -----
From: Marcello
To: [EMAIL PROTECTED]
Sent: Thursday, November 25, 2004 2:53 PM
Subject: RES: [delphi-br] Enviar e-mail com anexo via programacao
essa rotina não funcionou comigo, alguém conseguiu usa-la????
_____
De: Marcos Esteves Simao (GERIN) [mailto:[EMAIL PROTECTED]
Enviada em: quinta-feira, 25 de novembro de 2004 10:41
Para: '[EMAIL PROTECTED]'
Assunto: RES: [delphi-br] Enviar e-mail com anexo via programacao
Creio que deva declarar a unit ShellAPI
procedure Tfrm_RCP.btn_EnviaEMAIL(Sender: TObject);
var
pEMail: String;
begin
pEMail:= 'mailto:[EMAIL PROTECTED] da
mensagem"CAMINHO e NOME Arquivo Anexo" '
{$ifdef win32}
ShellExecute(Handle,'Open',pChar(pEmail),nil,nil,sw_Show);
{$endif}
end;
Marcos Esteves Simão
Programador de Computador - Unimed Vitória
[EMAIL PROTECTED]
GERIN - CODES
-----Mensagem original-----
De: Vanderlei [mailto:[EMAIL PROTECTED]
Enviada em: quinta-feira, 25 de novembro de 2004 09:24
Para: [EMAIL PROTECTED]
Assunto: [delphi-br] Enviar e-mail com anexo via programacao
Pessoal,
Preciso enviar um e-mail com anexo via programação, mas nao estou
encontrando uma rotina q faça isso, alguem
teria isso pra me enviar?
no aguardo
Vanderlei
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Links do Yahoo! Grupos
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Yahoo! Grupos, um serviço oferecido por:
PUBLICIDADE
<http://br.rd.yahoo.com/SIG=12aemeni1/M=264379.5078783.6203979.1588051/D=brc
lubs/S=2137111264:HM/EXP=1101472872/A=2332652/R=0/id=noscript/SIG=119058f8i/
*http://br.download.yahoo.com/messenger/>
_____
Links do Yahoo! Grupos
* Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
* Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<mailto:[EMAIL PROTECTED]>
* O uso que você faz do Yahoo! Grupos está sujeito aos Termos do
Serviço do Yahoo! <http://br.yahoo.com/info/utos.html> .
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Yahoo! Grupos, um serviço oferecido por:
------------------------------------------------------------------------------
Links do Yahoo! Grupos
a.. Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
b.. Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
c.. O uso que você faz do Yahoo! Grupos está sujeito aos Termos do Serviço
do Yahoo!.
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
