|
|
Регистрация | << Правила форума >> | 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
|
||||
|
||||
Сбасибо Вам огромное! И статьи хорошие и процедурки сейчас заюзаю.
Вы очень сильно помогли. Ещё раз спасибо)) |
#7
|
||||
|
||||
Всё таже каша
Ну с вордом то я так более менее разобрался. С оутлуком почти. Но есть ряд вопросов.
Имеется код: Код:
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 вываливается ошибка. суть задачи формировать письма по шабонам, и рассылать на указаные адреса. в самом аутлуке есть примеры на бейсике, но ввиду англоязычности не могу догнать истину((( надеюсь на вашу помощь. |
#8
|
||||
|
||||
myItem.Body:=Memo.Lines.Text
Что делать, когда сломался комп: 1. Если вы юзер - делать ноги. 2. Если ремонтник - делать деньги. 3. Если вы программист - делать вид, что так было задумано. |
#9
|
||||
|
||||
Развитие проблемы.
Да, это я мощно промахнулся. Спасибо за наставление на путь истинный =)
Что то я тут малость в тупик привстал. Существуют шаблоны писем в формате *.oft. Так вот необходимо средствами дельфи открывать имеющийся шаблон, на место "тэгов" подставлять актуальные значения и высылать шаблон письма адресатам. Я НЕ прошу решить за меня задачу. Но очень сильно прошу подсобить с поиском нужной информации.. Может я не те ключевые слова задаю при поисках, но ни в хелпе самого аутлука, ни в инете, не могу найти примеров работы с данными объектами. То есть примеров работы с аутлуком на таком уровне. Буду рад любой информации... Зарание спасибо. |
#10
|
||||
|
||||
Окно уведомлений Outlook
Сталкнулся с проблемой. Когда программа (написаная на дельфи) отправляет письмо, Outlook выводит окошко, уведомляющее о том, что некто, пытается от Вашего имени отправить письмо. и по истечению временного интервала дается возможность нажать кнопку "да" (разрешить отправить). Учитывая что письма будут отправлятся не одному десятку партнёров, операторы громко обматерят нас(программистов), за то что им приходится постояно нажимать сею кнопку.
Вопрос: Как отключить или скажем так, "Обойти" это окно ? |
#11
|
|||
|
|||
XIO
Смотри какая штука... Если внимательно посмотреть на Office файлы(хотя бы во время сохранения), то можно легко заметить, что все они шифруются, причем пользователю предоставляется возможность выбора шифрования! В Аутлуке я не видел такого, но шифрование присутствует... Что из этого получается? Ты не сможешь открыть с помощью Delphi шаблон(т.к. его надо расшифровать, а алгоритм не известен). Но это мое мнение. Я могу и ошибаться... А насчет сообщений - вполне решаемо... В МСДН в разделах "работа с оффис приложениями"(или как-то так) показывается как вызвать эти сообщения, ну и соответственно их можно и отключать! Но у меня нет под рукой МСДН, поэто смотри сам! Удачи! |
#12
|
||||
|
||||
Понял Вашу мысль. Спасибо большое за помощь.
|
#13
|
||||
|
||||
Очередная проблема
Запустил прогу на компе пользователя, у него нету администраторских прав, в связи с этим программа выдавала ошибку при коннекте к Аутлуку. То есть на сколько я понял система не дала подконектится проги к аутлуку... Или я чего то не понимаю. Код следующий:
Код:
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; Последний раз редактировалось XIO, 22.01.2008 в 15:03. |
#14
|
|||
|
|||
ИМХО, с твоими запросами, тебе надо сюда:
http://www.delphisources.ru/pages/so...mple_mail.html Будешь работать без OLE, не зависить от Offfice приложений, да и сам сделаешь так, чтобы не было боков! Ну просто нет смысла, ИМХО, использовать аутлук... Просто не вижу смысла искать методы доступа к получению прав администратора только для отправки почты... |
#15
|
||||
|
||||
Свойства olTaskItem для Outlook
Прошлый баг я таки победил. Поствил на клиентской машине дельфи, запустил отладчик, и увидел как прога запиналась на операторе
Код:
myItem.Display; Мне понравилось OLE, и я дальше продолжаю его использовать. Находил много описаний где перечисляются сами объекты "olMailItem...olTaskItem", но вот их свойства приведены не польностью, лишь некоторые в живых примерах. Лично меня очень интересуют свойства olTaskItem Знаю лишь эти: myItem.Subject := 'Заголовок'; myItem.Body := 'текст'; myItem.DueDate := Дата завершения; myItem.PercentComplete := процент завершения; myItem.Importance := Важность myItem.Status := Статус выполнения; А вот одно свойство, никак не могу откопать. Мне нужно ещё автоматом поставить галочку "Оповещение". Пробовал разные варианты слова notification, но никак не попадаю пальцем в недо. Кто-нибудь подскажите пожалуйста, как это свойство именуется. А так же нужно заполнить "Ответственное лицо". буду Рад любым информативным ответам. "Люди никогда не видят то, существование чего им кажется невозможным." ©Терри Пратчетт |