[XIO]

Доброго времени суток, уважаемые программисты.

Я действительно пытался найти ответы в инете и даже на этом форуме. Ненашёл(

Появилась необходимость формировать в дельфи письма, есть два варината. Либо формировать письмо и напряму передвать его в OutLook, либо создавать Word документы по имеющимся шаблонам и затем эти документы автоматом передавать в ОутЛук и отсылать по нужным адресам. Судя по всему придётся работать с компонентами находящимися на закладке Server, но я даже не имею понятия с какой стороны к ним подойти. Подскажите пожалуйста где можно найти примеров на эту тему, или ещё лучше хороший мануал по данным компонентам. Зарание благодарю.

[Rosenkrantz]

Посмотрите вот здесь описана работа с Word и Execel: http://www.kornjakov.ru/stat.htm

[~ SaM ~]

Ниже функции, с которыми работаю я. Эт работа с Вордом!

Код:

const
wdBorderTop=-1;
wdBorderLeft=-2;
wdBorderBottom=-3;
wdBorderRight=-4;

wdLineStyleNone=0;
wdLineStyleSingle=1;
wdLineStyleDot=2;
wdLineStyleDashSmallGap=3;
wdLineStyleDashLargeGap=4;
wdLineStyleDashDot=5;
wdLineStyleDashDotDot=6;
wdLineStyleDouble=7;
wdLineStyleTriple=8;
wdLineStyleThinThickSmallGap=9;
wdLineStyleThickThinSmallGap=10;
wdLineStyleThinThickThinSmallGap=11;
wdLineStyleThinThickMedGap=12;
wdLineStyleThickThinMedGap=13;
wdLineStyleThinThickThinMedGap=14;
wdLineStyleThinThickLargeGap=15;
wdLineStyleThickThinLargeGap=16;
wdLineStyleThinThickThinLargeGap=17;
wdLineStyleSingleWavy=18;
wdLineStyleDoubleWavy=19;
wdLineStyleDashDotStroked=20;
wdLineStyleEmboss3D=21;
wdLineStyleEngrave3D=22;


Function CreateWord:boolean;
Function VisibleWord(visible:boolean):boolean;
Function AddDoc:boolean;
Function SetTextToDoc(text_:string ;InsertAfter_:boolean):boolean;
Function SaveDocAs(file_:string):boolean;
Function SaveDocAsUnicod(file_:string):boolean;
Function SaveDocAsText(file_:string):boolean;
Function SaveDocAsDosText(file_:string):boolean;
Function CloseDoc:boolean;
Function CloseWord:boolean;
Function OpenDoc(file_:string):boolean;
Function StartOfDoc:boolean;
Function FindTextDoc(text_:string):boolean;
Function PasteTextDoc(text_:string):boolean;
Function TypeTextDoc(text_:string):boolean;
Function FindAndPasteTextDoc(findtext_,pastetext_:string):boolean;
Function PrintDialogWord:boolean;
Function CreateTable(NumRows, NumColumns:integer;var index:integer):boolean;
Function SetSizeTable(Table:integer;RowsHeight, ColumnsWidth:real):boolean;
Function GetSizeTable(Table:integer;var RowsHeight,ColumnsWidth:real):boolean;
Function SetHeightRowTable(Table,Row:integer;RowHeight:real):boolean;
Function SetWidthColumnTable(Table,Column:integer;ColumnWidth:real):boolean;
Function SetTextToTable(Table:integer;Row,Column:integer;text:string):boolean;
Function SetLineStyleBorderTable(Table:integer;Row,Column,wdBorderType,wdBorderStyle:integer):boolean;
Function SetMergeCellsTable(Table:integer;Row1,Column1,Row2,Column2:integer):boolean;

Function GetSelectionTable:boolean;
Function GoToNextTable (table_:integer):boolean;
Function GoToPreviousTable (table_:integer):boolean;
Function GetColumnsRowsTable(table_:integer; var Columns,Rows:integer):boolean;
Function GetColumnRowTable(table_:integer; var Column,Row:integer):boolean;
Function AddRowTableDoc (table_:integer):boolean;
Function InsertRowsTableDoc(table_,position_,count_:integer):boolean;
Function InsertRowTableDoc(table_,position_:integer):boolean;


//------------------------------- TextBox ---------------------------------
Function CreateTextBox(Left,Top,Width,Height:real;var name:string):boolean;
Function TextToTextBox(TextBox:variant;text:string):boolean;

//------------------------------- Линии -----------------------------------
Function CreateLine(BeginX,BeginY,EndX,EndY:real;var name:string):boolean;

//------------------------------- Внешний рисунок -------------------------
Function CreatePicture(FileName:string;Left,Top:real;var name:string):boolean;

//------------------------------- Общие для формы функции -----------------
Function DeleteShape (NameShape:variant): variant;
Function SetNewNameShape(NameShape:variant;NewNameShape:string):string;
Function GetNameIndexShape(NameIndex:variant):string;




implementation

uses ComObj;
 var W:variant;

Function CreateWord:boolean;
begin
CreateWord:=true;
try
W:=CreateOleObject('Word.Application');
except
CreateWord:=false;
end;
End;


Function VisibleWord(visible:boolean):boolean;
begin
VisibleWord:=true;
try
W.visible:= visible;
except
VisibleWord:=false;
end;
End;


Function AddDoc:boolean;
 Var Doc_:variant;
begin
AddDoc:=true;
try
Doc_:=W.Documents;
Doc_.Add;
except
AddDoc:=false;
end;
End;



Function SetTextToDoc(text_:string ;InsertAfter_:boolean):boolean;
 var Rng_:variant;
begin
SetTextToDoc:=true;
try
Rng_:=W.ActiveDocument.Range;
if InsertAfter_ then Rng_.InsertAfter(text_) else Rng_.InsertBefore(text_);
except
SetTextToDoc:=false;
end;
End;



Function SaveDocAs(file_:string):boolean;
begin
SaveDocAs:=true;
try
W.ActiveDocument.SaveAs(file_);
except
SaveDocAs:=false;
end;
End;


Function SaveDocAsUnicod(file_:string):boolean;
 const wdFormatUnicodeText=7;
begin
SaveDocAsUnicod:=true;
try
W.ActiveDocument.SaveAs(file_,FileFormat:=wdFormatUnicodeText);
except
SaveDocAsUnicod:=false;
end;
End;


Function SaveDocAsText(file_:string):boolean;
 const  wdFormatText=2;
begin
SaveDocAsText:=true;
try
W.ActiveDocument.SaveAs(file_,FileFormat:= wdFormatText);
except
SaveDocAsText:=false;
end;
End;


Function SaveDocAsDosText(file_:string):boolean;
 const  wdFormatDOSText=4;
begin
SaveDocAsDosText:=true;
try
W.ActiveDocument.SaveAs(file_,FileFormat:= wdFormatDOSText);
except
SaveDocAsDosText:=false;
end;
End;


Function CloseDoc:boolean;
begin
CloseDoc:=true;
try
W.ActiveDocument.Close;
except
CloseDoc:=false;
end;
End;


Function CloseWord:boolean;
begin
CloseWord:=true;
try
W.Quit;
except
CloseWord:=false;
end;
End;


Function OpenDoc(file_:string):boolean;
 Var Doc_:variant;
begin
OpenDoc:=true;
try
Doc_:=W.Documents;
Doc_.Open(file_);
except
OpenDoc:=false;
end;
End;


Function StartOfDoc:boolean;
begin
StartOfDoc:=true;
try
W.Selection.End:=0;
W.Selection.Start:=0;
except
StartOfDoc:=false;
end;
End;




Function FindTextDoc(text_:string):boolean;
begin
FindTextDoc:=true;
Try
W.Selection.Find.Forward:=true;
W.Selection.Find.Text:=text_;
FindTextDoc := W.Selection.Find.Execute;
except
FindTextDoc:=false;
end;
End;



Function PasteTextDoc(text_:string):boolean;
begin
PasteTextDoc:=true;
Try
W.Selection.Delete;
W.Selection.InsertAfter (text_);
except
PasteTextDoc:=false;
end;
End;


Function TypeTextDoc(text_:string):boolean;
begin
TypeTextDoc:=true;
Try
W.Selection.Delete;
W.Selection.TypeText(text_);
except
TypeTextDoc:=false;
end;
End;



Function FindAndPasteTextDoc(findtext_,pastetext_:string):boolean;
begin
FindAndPasteTextDoc:=true;
try
W.Selection.Find.Forward:=true;
W.Selection.Find.Text:= findtext_;
if W.Selection.Find.Execute then begin
W.Selection.Delete;
W.Selection.InsertAfter (pastetext_);
end else FindAndPasteTextDoc:=false;
except
FindAndPasteTextDoc:=false;
end;
End;



Function PrintDialogWord:boolean;
 Const wdDialogFilePrint=88;
begin
PrintDialogWord:=true;
try
W.Dialogs.Item(wdDialogFilePrint).Show;
except
PrintDialogWord:=false;
end;
End;


//----------- Таблицы  --------------------------------------------------
Function CreateTable(NumRows, NumColumns:integer;var index:integer):boolean;
 var sel_:variant;
begin
CreateTable:=true;
try
sel_:=W.selection;
W.ActiveDocument.Tables.Add(Range:=sel_.Range, NumRows:=NumRows, NumColumns:=NumColumns);
index:=W.ActiveDocument.Tables.Count;
except
CreateTable:=false;
end;
End;



Function SetSizeTable(Table:integer;RowsHeight, ColumnsWidth:real):boolean;
begin
SetSizeTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Columns.Width:=ColumnsWidth;
W.ActiveDocument.Tables.Item(Table).Rows.Height:=RowsHeight;
except
SetSizeTable:=false;
end;
End;



Function GetSizeTable(Table:integer;var RowsHeight,ColumnsWidth:real):boolean;
begin
GetSizeTable:=true;
try
ColumnsWidth:=W.ActiveDocument.Tables.Item(Table).Columns.Width;
RowsHeight:=W.ActiveDocument.Tables.Item(Table).Rows.Height;
except
GetSizeTable:=false;
end;
End;




Function SetHeightRowTable(Table,Row:integer;RowHeight:real):boolean;
begin
SetHeightRowTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Rows.item(Row).Height:=RowHeight;
except
SetHeightRowTable:=false;
end;
End;




Function SetWidthColumnTable(Table,Column:integer;ColumnWidth:real):boolean;
begin
SetWidthColumnTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Columns.Item(Column).Width:=ColumnWidth;
except
SetWidthColumnTable:=false;
end;
End;




Function SetTextToTable(Table:integer;Row,Column:integer;text:string):boolean;
begin
SetTextToTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Columns.Item(Column).Cells.Item(Row).Range.Text:=text;
except
SetTextToTable:=false;
end;
End;



Function SetLineStyleBorderTable(Table:integer;Row,Column,wdBorderType,wdBorderStyle:integer):boolean;
begin
SetLineStyleBorderTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Columns.Item(Column).Cells.Item(Row).Borders.Item(wdBorderType).LineStyle:=wdBorderStyle;
except
SetLineStyleBorderTable:=false;
end;
End;

[~ SaM ~]

И продолжение.

Код:

Function SetMergeCellsTable(Table:integer;Row1,Column1,Row2,Column2:integer):boolean;
 var cel_:variant;
begin
SetMergeCellsTable:=true;
try
cel_:=W.ActiveDocument.Tables.Item(Table).Cell(Row2,Column2);
W.ActiveDocument.Tables.Item(Table).Cell(Row1,Column1).Merge(cel_);
except
SetMergeCellsTable:=false;
end;
End;


Function GetSelectionTable:boolean;
  const wdWithInTable=12;
begin
try
GetSelectionTable :=W.Selection.Information[wdWithInTable];
except
GetSelectionTable :=false;
end;
End;



Function GoToNextTable (table_:integer):boolean;
 const wdGoToTable=2;
begin
 GoToNextTable:=true;
 try
   W.Selection.GoToNext (wdGoToTable);
 except
 GoToNextTable:=false;
 end;
End;


Function GoToPreviousTable (table_:integer):boolean;
 const wdGoToTable=2;
begin
 GoToPreviousTable:=true;
 try
   W.Selection.GoToPrevious(wdGoToTable);
 except
 GoToPreviousTable:=false;
 end;
End;



Function GetColumnsRowsTable(table_:integer; var Columns,Rows:integer):boolean;
 const
    wdMaximumNumberOfColumns=18;
    wdMaximumNumberOfRows=15;
begin
GetColumnsRowsTable:=true;
try
Columns:=W.Selection.Information[wdMaximumNumberOfColumns];
Rows:=W.Selection.Information[wdMaximumNumberOfRows];
except
GetColumnsRowsTable:=false;
end;
End;




Function GetColumnRowTable(table_:integer; var Column,Row:integer):boolean;
 const
   wdStartOfRangeColumnNumber=16;
   wdStartOfRangeRowNumber=13;
begin
GetColumnRowTable:=true;
try
Column:=W.Selection.Information[wdStartOfRangeColumnNumber];
Row:=W.Selection.Information[wdStartOfRangeRowNumber];
except
GetColumnRowTable:=false;
end;
End;



Function AddRowTableDoc (table_:integer):boolean;
begin
 AddRowTableDoc:=true;
 try
   W.ActiveDocument.Tables.Item(table_).Rows.Add;
 except
 AddRowTableDoc:=false;
 end;
End;



Function InsertRowsTableDoc(table_,position_,count_:integer):boolean;
begin
 InsertRowsTableDoc:=true;
 try
  W.ActiveDocument.Tables.Item(table_).Rows.Item(position_).Select;
  W.Selection.InsertRows (count_);
 except
 InsertRowsTableDoc:=false;
 end;
End;



Function InsertRowTableDoc(table_,position_:integer):boolean;
 var row_:variant;
begin
 InsertRowTableDoc:=true;
 try
 row_:=W.ActiveDocument.Tables.Item(table_).Rows.Item(position_);
 W.ActiveDocument.Tables.Item(table_).Rows.Add(row_);
 except
 InsertRowTableDoc:=false;
 end;
End;



//------------------------------ TextBox ----------------------------------
Function CreateTextBox(Left,Top,Width,Height:real;var name:string):boolean;
 const msoTextOrientationHorizontal=1;
begin
CreateTextBox:=true;
try
name:=W.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,Left,Top,Width,Height).Name;
except
CreateTextBox:=false;
end;
End;


Function TextToTextBox(TextBox:variant;text:string):boolean;
 const msoTextBox=17;
begin
TextToTextBox:=true;
try
if w.ActiveDocument.Shapes.Item(TextBox).Type = msoTextBox then
   W.ActiveDocument.Shapes.Item(TextBox).TextFrame.TextRange.Text:=Text
   else TextToTextBox:=false;
except
TextToTextBox:=false;
end;
End;



Function CreateLine(BeginX,BeginY,EndX,EndY:real;var name:string):boolean;
begin
CreateLine:=true;
try
name:=W.ActiveDocument.Shapes.AddLine(BeginX,BeginY,EndX,EndY).Name;
except
CreateLine:=false;
end;
End;


Function CreatePicture(FileName:string;Left,Top:real;var name:string):boolean;
begin
CreatePicture:=true;
try
name:=W.ActiveDocument.Shapes.AddPicture(FileName).Name;
W.ActiveDocument.Shapes.Item(name).Left:=Left;
W.ActiveDocument.Shapes.Item(name).Top:=Top;
except
CreatePicture:=false;
end;
End;




Function GetNameIndexShape(NameIndex:variant):string;
begin
try
GetNameIndexShape:=W.ActiveDocument.Shapes.Item(NameIndex).Name;
except
GetNameIndexShape:='';
end;
End;



Function SetNewNameShape(NameShape:variant;NewNameShape:string):string;
begin
try
W.ActiveDocument.Shapes.Item(NameShape).Name:=NewNameShape;
SetNewNameShape:=NewNameShape;
except
SetNewNameShape:='';
end;
End;


Function DeleteShape (NameShape:variant): variant;
Begin
DeleteShape:=true;
try
W.ActiveDocument.Shapes.Item(NameShape).Delete;
except
DeleteShape:=false;
end;
End;

[~ SaM ~]

Вот тебе по Аутлуку...Но только совсем чуть-чуть....просто я особо не разбирался с OutlookApplication, т.к. небыло необходимости. Тестил для Outlook 2000.

Код:

unit AOutlook;

interface


uses
Windows, Classes, ActiveX, Outlook2000;

type
TOutlookObject = class
private
FOutlookApp:OutlookApplication;
public
constructor Create;
destructor Destroy; override;
property Application:OutlookApplication read FOutlookApp;
end;

implementation

uses
ComObj, Variants;

{ TOutlookObject implementation }

constructor TOutlookObject.Create;
var
Mail:_MailItem;
begin
FOutlookApp:=CoOutlookApplication.Create;
Mail:=FOutlookApp.CreateItem(olMailItem) as _MailItem;
Mail.Body:='Тест письма';
Mail.Subject:='Тест';
Mail.To_:='Иванов Иван Иванович';
Mail.Save;      //Для сохранения письма в черовике
Mail.Send;      //Отправить
Mail.Display(0); //Если необходимо вывести на экран само письмо
Mail.CC:='xolod';//Отправить кому-либо копию письма.
Mail.BCC:='mmail';//Скрыто от первого получателя
Mail.MessageClass:='aa';    
FOutlookApp.Quit;   //Выходим из Аутлука
end;

destructor TOutlookObject.Destroy;
begin
try
except
end;
inherited Destroy;
end;

end.

Теперь код для клиента:

Код:

unit DMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleServer, StdCtrls, Buttons;

type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses AOutlook;

var
OutlookObject:TOutlookObject;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if not Assigned(OutlookObject) then
begin
OutlookObject:=TOutlookObject.Create;
end;
if Assigned(OutlookObject) then
begin
OutlookObject.Destroy;
OutlookObject:=nil;
end;
end;

end.

[XIO]

Сбасибо Вам огромное! И статьи хорошие и процедурки сейчас заюзаю.
Вы очень сильно помогли. Ещё раз спасибо))

[XIO]

Ну с вордом то я так более менее разобрался. С оутлуком почти. Но есть ряд вопросов.
Имеется код:

Код:

procedure TForm1.Button7Click(Sender: TObject);
Var
  myItem, myAttachments, myAttachment : Variant;
begin
  Try
    If VarType(OleOutlook) <> varDispatch Then
      OleOutlook := CreateOleObject('Outlook.Application');
    myItem := OleOutlook.CreateItem(olMailItem);
    myItem.Display;
    myItem.To := 'Адреса получателей...';
    myItem.Subject := 'Test My Mail';
    myItem.Body := 'Test My Mail';
    myAttachments := myItem.Attachments;
    //myAttachment := myAttachments.Add("c:\read_me.txt");
    myItem.Send;
  Except
    ShowMessage('OLE error!');
  End;
  OleOutlook := Unassigned;
end;

Данный код вполне работоспособен. Но! Есть ряд нареканий. Во первых myItem.Body имеет тип строки и при попытки присвоить даному свойству Memo.Lines вываливается ошибка.

суть задачи формировать письма по шабонам, и рассылать на указаные адреса. в самом аутлуке есть примеры на бейсике, но ввиду англоязычности не могу догнать истину((( надеюсь на вашу помощь.

[The Shadow]

myItem.Body:=Memo.Lines.Text

[XIO]

Да, это я мощно промахнулся. Спасибо за наставление на путь истинный =)

Что то я тут малость в тупик привстал. Существуют шаблоны писем в формате *.oft. Так вот необходимо средствами дельфи открывать имеющийся шаблон, на место "тэгов" подставлять актуальные значения и высылать шаблон письма адресатам.

Я НЕ прошу решить за меня задачу. Но очень сильно прошу подсобить с поиском нужной информации.. Может я не те ключевые слова задаю при поисках, но ни в хелпе самого аутлука, ни в инете, не могу найти примеров работы с данными объектами. То есть примеров работы с аутлуком на таком уровне. Буду рад любой информации...
Зарание спасибо.

[XIO]

Сталкнулся с проблемой. Когда программа (написаная на дельфи) отправляет письмо, Outlook выводит окошко, уведомляющее о том, что некто, пытается от Вашего имени отправить письмо. и по истечению временного интервала дается возможность нажать кнопку "да" (разрешить отправить). Учитывая что письма будут отправлятся не одному десятку партнёров, операторы громко обматерят нас(программистов), за то что им приходится постояно нажимать сею кнопку.
Вопрос: Как отключить или скажем так, "Обойти" это окно ?

[~ SaM ~]

XIO

Смотри какая штука... Если внимательно посмотреть на Office файлы(хотя бы во время сохранения), то можно легко заметить, что все они шифруются, причем пользователю предоставляется возможность выбора шифрования! В Аутлуке я не видел такого, но шифрование присутствует... Что из этого получается? Ты не сможешь открыть с помощью Delphi шаблон(т.к. его надо расшифровать, а алгоритм не известен).

Но это мое мнение. Я могу и ошибаться...


А насчет сообщений - вполне решаемо... В МСДН в разделах "работа с оффис приложениями"(или как-то так) показывается как вызвать эти сообщения, ну и соответственно их можно и отключать! Но у меня нет под рукой МСДН, поэто смотри сам!

Удачи!

[XIO]

Понял Вашу мысль. Спасибо большое за помощь.

[XIO]

Запустил прогу на компе пользователя, у него нету администраторских прав, в связи с этим программа выдавала ошибку при коннекте к Аутлуку. То есть на сколько я понял система не дала подконектится проги к аутлуку... Или я чего то не понимаю. Код следующий:

Код:

Procedure SendMess(TOAdrs,Subject:String;Body:Variant);
var
  myItem, myAttachments, myAttachment : Variant;
begin
      Try
        If VarType(Form1.OleOutlook) <> varDispatch Then
          Form1.OleOutlook := CreateOleObject('Outlook.Application');
        myItem := Form1.OleOutlook.CreateItem(olMailItem);
        myItem.Display;
        myItem.To := TOAdrs;
        myItem.Subject := Subject; 
        myItem.Body := Body;
        myAttachments := myItem.Attachments;
        myItem.Send;
      Except
        ShowMessage('OLE error!');
      End;
  Form1.OleOutlook := Unassigned;
end;

[~ SaM ~]

ИМХО, с твоими запросами, тебе надо сюда:

http://www.delphisources.ru/pages/so...mple_mail.html

Будешь работать без OLE, не зависить от Offfice приложений, да и сам сделаешь так, чтобы не было боков!

Ну просто нет смысла, ИМХО, использовать аутлук... Просто не вижу смысла искать методы доступа к получению прав администратора только для отправки почты...

[XIO]

Прошлый баг я таки победил. Поствил на клиентской машине дельфи, запустил отладчик, и увидел как прога запиналась на операторе

Код:

myItem.Display;

Почему этого не происходило на моей машине, а на клиентской произошло, пока не понял. Ну и ладно. Сейчас другая задача.
Мне понравилось OLE, и я дальше продолжаю его использовать.

Находил много описаний где перечисляются сами объекты "olMailItem...olTaskItem", но вот их свойства приведены не польностью, лишь некоторые в живых примерах.

Лично меня очень интересуют свойства olTaskItem

Знаю лишь эти:
myItem.Subject := 'Заголовок';
myItem.Body := 'текст';
myItem.DueDate := Дата завершения;
myItem.PercentComplete := процент завершения;
myItem.Importance := Важность
myItem.Status := Статус выполнения;
А вот одно свойство, никак не могу откопать. Мне нужно ещё автоматом поставить галочку "Оповещение".
Пробовал разные варианты слова notification, но никак не попадаю пальцем в недо. Кто-нибудь подскажите пожалуйста, как это свойство именуется.
А так же нужно заполнить "Ответственное лицо".
буду Рад любым информативным ответам.