Hello all experts,
procedure TForm1.domail(Sender: TObject; fromname, fromadd, sub, toadd, thedocdone, theacc: string; body: widestring);
const
olMailItem = 0;
var
Outlook: OLEVariant;
vmailitem: variant;
Attachment: TIdAttachment;
savetofol: string;
begin
try
Outlook := GetActiveOleObject('Outlook.Application');
except
Outlook := CreateOleObject('Outlook.Application');
end;
vmailitem := Outlook.CreateItem(olMailItem);
vmailitem.Recipients.Add(toadd);
vmailitem.ReplyRecipients.Add('email#email.com');
vmailitem.Subject := sub;
vmailitem.body := 'SENT: ' + formatdatetime('dd mmmm yyyy - hh:nn am/pm', now) + #13#10 + body;
vmailitem.ReadReceiptRequested := true;
vmailitem.importance := 2;
if thedocdone <> 'NIL' then
begin
vmailitem.Attachments.Add(thedocdone, 1, 1, 'SBSA_' + theacc);
if ansipos('string1', lowercase(toadd)) <> 0 then
begin
vmailitem.Attachments.Add('*manual path', 1, 2, '*manual name');
Memo1.Lines.Add('Adding consent letter to mail...');
end;
if ansipos('string2', lowercase(toadd)) <> 0 then
begin
vmailitem.Attachments.Add('*manual path', 1, 2, '*manual name');
Memo1.Lines.Add('Adding consent letter to mail...');
end;
savetofol := extractfilepath(thedocdone) + copy(extractfilename(thedocdone), 0, length(extractfilename(thedocdone)) - 8);
vmailitem.saveas(savetofol + '_eml.doc', 4); // ^ +'.doc'
end;
// vmailitem.clear;
vmailitem.Send;
Outlook := Unassigned;
end;
With the above piece of code i am able to attach to outlook and send out an email and attach an attachment to that mail...
My problem is that IT WONT attach the 2nd attachment... ??? i have tried every which way using different methods to do this but i just cannot get the 2nd attachment to attach to the mail...
Please help...
See Attachments Object (Outlook):
To ensure consistent results, always save an item before adding or
removing objects in the Attachments collection of the item.
Wrong:
vmailitem.Attachments.Add();
vmailitem.Attachments.Add();
vmailitem.Attachments.Add();
Right:
vmailitem.Attachments.Add();
vmailitem.save;
vmailitem.Attachments.Add();
vmailitem.save;
vmailitem.Attachments.Add();
vmailitem.save;
Related
How can I add a large text file (actually a HTML file) as an attachment to a channel in Slack? A working example would be great. I use SDriver - the included demo works fine to send some strings, but I don't find anything on how to use attachments.
What I did so far:
procedure TForm1.SendActionExecute(Sender: TObject);
var
LWebHook: IMessageBuffer;
LMessage: IMessage;
LStopWatch: TStopWatch;
vAttachment: IAttachment;
vField: IFields;
begin
LStopWatch := TStopWatch.StartNew;
LMessage := TMessage.Create(EditMessage.Text + ' [' + TimeToStr(Now) + ']');
LMessage.UserName := EditUserName.Text;
LMessage.Icon_URL := EditIcon_URL.Text;
LMessage.Icon_Emoji := EditIcon_Emoji.Text;
LMessage.Channel := EditChannel.Text;
vAttachment := LMessage.AddAttachment;
vField := vAttachment.AddFields;
vField.Title := 'Title';
vField.Value := 'Value';
///////////////////////////////////////////////////////
// How can I add a large text file as attachment here ?
///////////////////////////////////////////////////////
LWebHook := TIncomingWebHook.Create(EditWebHookURL.Text, False);
LWebHook.Push(LMessage);
LWebHook.Flush;
end;
I use Delphi RAD Studio 2010 and the next code to send email with Outlook:
procedure SendOutlookMail(email,subject,body,fileat:string);
const
olMailItem = 0;
var
vMailItem: variant;
Outlook: OutlookApplication;
NmSpace: NameSpace;
Folder: MAPIFolder;
begin
Outlook := CoOutlookApplication.Create;
NmSpace := Outlook.GetNamespace('MAPI');
NmSpace.Logon('', '', False, False);
Folder := NmSpace.GetDefaultFolder(olFolderInbox);
Folder.Display;
vMailItem := Outlook.CreateItem(olMailItem);
if email<>'' then vMailItem.Recipients.Add(email);
vMailItem.Subject := subject;
vMailItem.Body := Body;
vMailItem.Attachments.Add(fileat);
vMailItem.Display(false);
end;
It opens a new Outlook message and bring it to front to just press "Send" to send it. That's ok. The problem is, creating a new email message with this method doesn't add the signature. If I create a new message within Ms Outlook, the signature is added automatically.
Is there anyway I can add the signature that the user has configured in MS Outlook? (without adding the signature text to "Body" string variable). Thanks in advance.
the signature is added when you call MailItem.Display or access MailItem.GetInspecrtor.
Call MailItem.Display first (the signature will be added at that moment), then merge your data with the existing body. Note that setting the plain text Body property will wipe out formatting, so you will need to work with the HTMLBody property. Keep in mind that 2 HTML strings cannot be simply concatenated - read the HTMLBody property, find the appropriate insertion position (after the <body> tag?), then insert your data.
//Here is how I did it in Delphi. It shows the part no-one else did, which is //parsing the email HTML and putting your text above the signature.
//The part at the beginning loads up the string that I will be adding, so you //could ignore that.
procedure TfrmEngInfo2.CreateMSOutlookHoldEmail;
var
i: Integer;
Outlook: OleVariant;
Mail: OleVariant;
EmailTo,EmailCC: string;
SubjectLine: string;
PartNbr,PONbr,JobNbr: string;
HTMLInfo: string;
JobInfo: string;
x: integer;
iPos: integer;
RealPosition,GTPosition: integer;
const
olMailItem = 0;
olByValue = 1;
olFormatHTML = 2;
begin
SubjectLine := 'PCB Hold /';
if JOBHEMAI.state = dsInactive then
JOBHEMAI.open;
if CUST.state = dsInactive then CUST.open;
if RELEASE.FindKey([AdsQuery1.FieldByName('R-JOB#').asstring, AdsQuery1.FieldByName('R-RELEASE-NBR').asstring]) then
begin
PONbr := RELEASE.FieldByName('R-PO-NBR').asstring;
JobNbr := AdsQuery1.FieldByName('R-JOB#').asstring + AdsQuery1.FieldByName('R-RELEASE-NBR').asstring;
SubjectLine := SubjectLine + ' PO#: ' + PONbr + ' / ';
end;
if JOBHEMAI.FindKey([AdsQuery1.FieldByName('R-JOB#').asstring]) then
EmailTo := JOBHEMAI.FieldByName('HoldEmailAddress').asstring;
if HEADER.FindKey([AdsQuery1.FieldByName('R-JOB#').asstring]) then
begin
PartNbr := HEADER.FieldByName('H-PART#').asstring;
SubjectLine := SubjectLine + ' Part#: ' + PartNbr;
if CUST.FindKey([HEADER.FieldByName('H-CUST-NBR').asstring]) then
if EmailTo = '' then
EmailTo := CUST.FieldByName('HoldEmailAddress').asstring;
if SALEPRSN.FindKey([HEADER.FieldByName('H-SLMN#').asstring]) then
EmailCC := SALEPRSN.fieldByName('E-mail').asstring;
end;
SubjectLine := SubjectLine + JobNbr;
try
Outlook := GetActiveOleObject('Outlook.Application');
except
Outlook := CreateOleObject('Outlook.Application');
end;
JobInfo := 'We have released the hold for your job Part: ' + PartNbr + ' PO: ' + PONbr
+ 'Job Number: ' + JobNbr;
Mail := Outlook.CreateItem(olMailItem);
Mail.To := EmailTo;
Mail.cc := EmailCC;
Mail.Subject := SubjectLine;
// Main.Attachments.Add('c:\test.jpg', olByValue, 1, 'My Test Image');
Mail.BodyFormat := olFormatHTML;
//This load the HTMLBody with all the outlook stuff including the users signature. Basically a blank email message
Mail.GetInspector;
// Find the position of the opening <body command.
x := pos('<body',Mail.HTMLBody);
// Put the HTMLBody in to a string field so we can examine it.
HTMLInfo := Mail.HTMLBody;
// Now loop through and find the position of the closing tag. '>' It must be in a position greater than the starting tag
RealPosition := 0;
while pos('>',HTMLInfo) > 0 do
begin
GTPosition := pos('>',HTMLInfo);
RealPosition := RealPosition + GTPosition;
if RealPosition > x then
break;
HTMLInfo := copy(HTMLInfo,GTPosition + 1,Length(HTMLInfo) - GTPosition);
end;
// Since we destroyed the HTMLInfo in the analysis, load it again.
HTMLInfo := Mail.HTMLBody;
// Now insert our information at the right spot.
insert(JobInfo,HTMLInfo,RealPosition + 1);
// Now load the modified HTMLInfo back to the Mail.HTMLBody so that it can display in the message.
Mail.HTMLBody := HTMLInfo;
// Finally display the Outlook Email
Mail.Display;
Outlook := unassigned;
end;
I have the following code I use for retrieving mails from a POP3 account.
It is working very well most of the time, but from time to time there are some mails where it doesn't retrieve the body.
If I test the IdMessage.MessageParts.Count it says that it is 0 - if I use another mailclient to retrieve the mail there is no problem.
I have a TIdPOP3 and a TIdMessage component on the form.
The connection is OK as there may be some mails that are show OK.
I can't figure out any system in which mails are not shown correct and which are not. But there might be one.
I use Delphi XE3 and the Indy is version 10.5.9.0
procedure TfrmJsMailCollect.lstMailsClick(Sender: TObject);
var
MailBody: string;
intIndex: integer;
begin
if (lstMails.Items.Count = 0) or (lstMails.SelCount = 0) then
Exit;
MailBody := '';
try
begin
mmoBody.Clear;
lstMails.Selected.SubItems.Strings[0];
lstMails.Selected.ImageIndex := 4;
conPOP3.Retrieve(lstMails.Selected.Index + 1, IdMessage);
for intIndex := 0 To Pred(IdMessage.MessageParts.Count) do
begin
if (IdMessage.MessageParts.Items[intIndex] is TIdAttachmentFile) then
begin // Attachments are skipped
end
else
begin // body text
if Pos('text/plain', IdMessage.MessageParts.Items[intIndex].ContentType) <> 0 then
begin
if TIdText(IdMessage.MessageParts.Items[intIndex]).Body.Text <> '' then
begin
MailBody := MailBody + TIdText(IdMessage.MessageParts.Items[intIndex]).Body.Text;
mmoBody.Lines.Add(MailBody);
MemoValidate;
end;
end;
end;
end;
end;
mmoBody.CaretPos.SetLocation(0, 0);
Application.ProcessMessages;
except
Logfile.Error('F_JsMailCollect.lstMailsClick - ' + cxGetResourceString(#sLangPop3ErrorReading));
end;
end;
With advice from Remy Lebeau and searching the web I ended up with the code below. This does the trick for now, but I would like to improve it so that the memo on my form only shows a nice message that would be readable for everyone - but that may come later.
procedure TfrmJsMailCollect.lstMailsClick(Sender: TObject);
var
MailBody: string;
i: integer;
ContentType: string;
begin
if (lstMails.Items.Count = 0) or (lstMails.SelCount = 0) then
Exit;
try
MailBody := '';
mmoBody.Clear;
lstMails.Selected.SubItems.Strings[0];
lstMails.Selected.ImageIndex := 4;
conPOP3.Retrieve(lstMails.Selected.Index + 1, IdMessage);
ContentType := IdMessage.ContentType;
case PosInStrArray(ContentType, ['multipart/mixed', 'multipart/alternative', 'text/html', 'text/plain'], False) of
0: begin { multipart/mixed }
for i := 0 To Pred(IdMessage.MessageParts.Count) do
begin
if TIdText(IdMessage.MessageParts.Items[i]).Body.Text <> '' then
begin
MailBody := MailBody + TIdText(IdMessage.MessageParts.Items[i]).Body.Text;
mmoBody.Lines.Add(MailBody);
MemoValidate;
end;
end;
end;
1: begin { multipart/alternative }
for i := 0 To Pred(IdMessage.MessageParts.Count) do
begin
if TIdText(IdMessage.MessageParts.Items[i]).Body.Text <> '' then
begin
MailBody := MailBody + TIdText(IdMessage.MessageParts.Items[i]).Body.Text;
mmoBody.Lines.Add(MailBody);
MemoValidate;
end;
end;
end;
2: begin { text/html }
mmoBody.Lines := IdMessage.Body;
MemoValidate;
end;
3: begin { text/plain }
mmoBody.Lines := IdMessage.Body;
MemoValidate;
end;
else
// nothing supported to display...
end;
mmoBody.CaretPos.SetLocation(0, 0);
Application.ProcessMessages;
except
Logfile.Error('F_JsMailCollect.lstMailsClick - ' + cxGetResourceString(#sLangPop3ErrorReading));
end;
end;
Not all email content is parsed into the TIdMessage.MessageParts collection. MIME parts and attachments are, but other content gets parsed into the TIdMessage.Body instead, which you are completely ignoring. You need to look at the TIdMessage.ContentType when deciding where to extract content from. Attachments will always be in TIdMessage.MessageParts, but text may or may not be, depending on the TIdMessage.ContentType.
I am trying to find out which form and element belongs too. The code that I now understand from this website:
http://www.cryer.co.uk/brian/delphi/twebbrowser/read_write_form_elements.htm
containing this code
function GetFormFieldNames(fromForm: IHTMLFormElement): TStringList;
var
index: integer;
field: IHTMLElement;
input: IHTMLInputElement;
select: IHTMLSelectElement;
text: IHTMLTextAreaElement;
begin
result := TStringList.Create;
for index := 0 to fromForm.length do
begin
field := fromForm.Item(index,'') as IHTMLElement;
if Assigned(field) then
begin
if field.tagName = 'INPUT' then
begin
// Input field.
input := field as IHTMLInputElement;
result.Add(input.name);
end
else if field.tagName = 'SELECT' then
begin
// Select field.
select := field as IHTMLSelectElement;
result.Add(select.name);
end
else if field.tagName = 'TEXTAREA' then
begin
// TextArea field.
text := field as IHTMLTextAreaElement;
result.Add(text.name);
end;
end;
end;
end;
seems to be working fine for most sites. However there are a few websites such as this one:
http://service.mail.com/registration.html#.1258-bluestripe-product1-undef
By looking at that code and comparing it with the active id, I can find the form it is in. However it does not work for that website. for some reason I think it has to do with htmldocument3 adn that this code is for htmldocument2. But I am not sure.
so my question is How can I extract a tstringlist from this website with all the elements names in them? hope you can help!
Edited: Added some code
begin
theForm := GetFormByNumber(webbrowser1.document as IHTMLDocument2,
0);
fields := GetFormFieldNames(theForm);
num := fields.IndexOf(theid);
end;
until (num <> -1);
One complication with locating form elements in a web page is that the page may contain frames and there may be forms in any of the frames. Basically, you have to iterate through all the frames and the forms in each frame. Once you get the form as an IHTMLFormElement, use Cryer's function to get the form element names.
The example link you gave does not have any frames and you should have had no problems getting your list of form elements, unless you tried to get the form by name because it had no name assigned. I had no problem getting the form element names and values using the following procedure
procedure GetForms(doc1: IHTMLDocument2; var sl: TStringList);
var
i, j, n: integer;
docForm: IHTMLFormElement;
slt: TStringList;
s: string;
begin
if doc1 = nil then
begin
ShowMessage('doc1 is empty [GetForms]');
Exit;
end;
slt := TStringList.Create;
n := NumberOfForms(doc1);
sl.Add('Forms: ' + IntToStr(n));
for i := 0 to n - 1 do
begin
docForm := GetFormByNumber(doc1, i);
sl.Add('Form Name: ' + docForm.Name);
slt.Clear;
slt := GetFormFieldNames(docForm);
for j := 0 to slt.Count - 1 do
begin
s := GetFieldValue(docForm, slt[j]);
sl.Add('Field Name: ' + slt[j] + ' value: "' + s + '"');
end;
end;
sl.Add('');
slt.Free;
end;
Cryer's example for navigating a frameset will not work for all web sites, see http://support.microsoft.com/support/kb/articles/Q196/3/40.ASP. The following function successfuly extracts a frame as an IHTMLDocument2 on all sites I have tried
function GetFrameByNumber(Doc:IHTMLDocument2; n:integer):IHTMLDocument2;
var
Container: IOleContainer;
Enumerator: ActiveX.IEnumUnknown;
Unknown: IUnknown;
Browser: IWebBrowser2;
Fetched: Longint;
NewDoc: IHTMLDocument2;
i : integer;
begin
// We cannot use the document's frames collection here, because
// it does not work in every case (i.e. Documents from a foreign domain).
// From: http://support.microsoft.com/support/kb/articles/Q196/3/40.ASP
i := 0;
if (Supports(Doc, IOleContainer, Container)) and
(Container.EnumObjects(OLECONTF_EMBEDDINGS, Enumerator) = S_OK) then
begin
while Enumerator.Next(1, Unknown, #Fetched) = S_OK do
begin
if (Supports(Unknown, IWebBrowser2, Browser)) and
(Supports(Browser.Document, IHTMLDocument2, NewDoc)) then
begin
// Here, NewDoc is an IHTMLDocument2 that you can query for
// all the links, text edits, etc.
if i=n then
begin
Result := NewDoc;
Exit;
end;
i := i+1;
end;
end;
end;
end;
Here is an example of how I have used GetForms and GetFrameByNumber
// from the TForm1 declaration
{ Public declarations }
wdoc: IHTMLDocument2;
procedure TForm1.btnAnalyzeClick(Sender: TObject);
begin
wdoc := WebBrowser.Document as IHTMLDocument2;
GetDoc(wdoc);
end;
procedure TForm1.GetDoc(doc1: IHTMLDocument2);
var
i, n: integer;
doc2: IHTMLDocument2;
frame_dispatch: IDispatch;
frame_win: IHTMLWindow2;
ole_index: olevariant;
sl: TStringList;
begin
if doc1 = nil then
begin
ShowMessage('Web doc is empty');
Exit;
end;
Form2.Memo1.Lines.Clear;
sl := TStringList.Create;
n := doc1.frames.length;
sl.Add('Frames: ' + IntToStr(n));
// check each frame for the data
if n = 0 then
GetForms(doc1, sl)
else
for i := 0 to n - 1 do
begin
sl.Add('--Frame: ' + IntToStr(i));
ole_index := i;
frame_dispatch := doc1.Frames.Item(ole_index);
if frame_dispatch <> nil then
begin
frame_win := frame_dispatch as IHTMLWindow2;
doc2 := frame_win.document;
// sl.Add(doc2.body.outerHTML);
GetForms(doc2,sl);
GetDoc(doc2);
end;
end;
// Form2 just contains a TMemo
Form2.Memo1.Lines.AddStrings(sl);
Form2.Show;
sl.Free;
end;
The logic in your example is faulty, 1. when there is only 1 form on the web page the list of form elements is never extracted, 2. the repeat loop will result in a access violation unless the the tag in "theid" is found
Here is your example cut down to successfully extract the form elements.
var
i : integer;
nforms : integer;
document : IHTMLDocument2;
theForm : IHTMLFormElement;
fields : TStringList;
theform1 : integer;
num : integer;
theid : string;
begin
fields := TStringList.Create;
theid := 'xx';
// original code follows
i := -1;
// nforms := NumberOfForms(webbrowser1.document as IHTMLDocument2);
// document := webbrowser1.document as IHTMLDocument2;
// if nforms = 1 then
// begin
// theForm := GetFormByNumber(webbrowser1.document as IHTMLDocument2, 0);
// theform1 := 0;
// end
// else
begin
// repeat
begin
inc(i);
theForm := GetFormByNumber(webbrowser1.document as IHTMLDocument2,
i);
fields := GetFormFieldNames(theForm);
num := fields.IndexOf(theid);
theform1 := i;
end;
// until (num <> -1);
end;
// end of original code
Memo1.Lines.Text := fields.Text;
fields.Free;
end;
Hm, are you sure this link contains any form elements? At least I did not see any visible ones. Perhaps they are hidden - did not check this myself, however.
Michael
I have created a program that can read email from Exchange 2007. However, it can only read the body of the email in plain-text format. When I tried to retrieve email in HTML format, my software cannot read the body and it always blank. I am using Delphi 2007 and IMAP 9.
Update:
Here is my code:
procedure TForm1.tmrCekTimer(Sender: TObject);
var
TheFlags: TIdMessageFlagsSet;
TheUID: string;
TheMsg: TIdMessage;
MailBoxName: string;
MyClass: TComponent;
begin
MailBoxName := 'INBOX';
if TheImap.SelectMailBox(MailBoxName) = False then
begin
Screen.Cursor := crDefault;
ShowMessage('Error selecting '+MailBoxName);
Exit;
end;
TheMsg := TIdMessage.Create(nil);
nCount := TheImap.MailBox.TotalMsgs;
TheMsg.ContentType := 'multipart/alternative';
TheMsg.Encoding := meMime;
if nCount = 0 then begin
StringGrid1.RowCount := 2;
StringGrid1.Cells[0, 1] := '';
StringGrid1.Cells[1, 1] := '';
StringGrid1.Cells[2, 1] := '';
StringGrid1.Cells[3, 1] := '';
ShowMessage('There are no messages in '+MailBoxName);
end else begin
StringGrid1.RowCount := nCount + 1;
for i := 0 to nCount-1 do begin
TheImap.GetUID(i+1, TheUID);
TheImap.UIDRetrieveFlags(TheUID, TheFlags);
TheImap.UIDRetrieve(TheUID, TheMsg);
//TheImap.UIDRetrieveHeader(TheUID, TheMsg);
StringGrid1.Cells[0, i+1] := IntToStr(i+1);
StringGrid1.Cells[1, i+1] := TheMsg.From.Address;
//StringGrid1.Cells[1, i+1] := TheUID;
if mfSeen in TheFlags then
StringGrid1.Cells[2, i+1] := 'Yes'
else begin
StringGrid1.Cells[2, i+1] := 'No';
end;
end;
end;
The contents of MIME-encoded emails, such as HTML emails (if plain-text and/or attachments are also present) are stored in the TIdMessage.MessageParts property, not in the TIdMessage.Body property. You need to look at the email's actual ContentType property to know which property TIdMessage parsed the email into.
Using MAPI, I usually try to get the PR_BODY_HTML property as string; if that’s empty, I retrieve the PR_HTML property.
const
PR_HTML = $10130102;
PR_BODY_HTML = $1013001E;
This usually works for me. Of course, maybe you’re using different technology altogether, but you’re not giving us much to work with...