|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
||||
|
||||
Работа с MS Outlook и MS Word средствами Delphi
Доброго времени суток, уважаемые программисты.
Я действительно пытался найти ответы в инете и даже на этом форуме. Ненашёл( Появилась необходимость формировать в дельфи письма, есть два варината. Либо формировать письмо и напряму передвать его в OutLook, либо создавать Word документы по имеющимся шаблонам и затем эти документы автоматом передавать в ОутЛук и отсылать по нужным адресам. Судя по всему придётся работать с компонентами находящимися на закладке Server, но я даже не имею понятия с какой стороны к ним подойти. Подскажите пожалуйста где можно найти примеров на эту тему, или ещё лучше хороший мануал по данным компонентам. Зарание благодарю. |
#2
|
|||
|
|||
Посмотрите вот здесь описана работа с Word и Execel: http://www.kornjakov.ru/stat.htm
|
#3
|
|||
|
|||
Ниже функции, с которыми работаю я. Эт работа с Вордом!
Код:
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 ~ за это полезное сообщение: | ||
RustDelphi (08.05.2012)
|
#4
|
|||
|
|||
И продолжение.
Код:
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; |
#5
|
|||
|
|||
Вот тебе по Аутлуку...Но только совсем чуть-чуть....просто я особо не разбирался с 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. |
#6
|
||||
|
||||
Сбасибо Вам огромное! И статьи хорошие и процедурки сейчас заюзаю.
Вы очень сильно помогли. Ещё раз спасибо)) |