Delphi / MS Office 97 / OLE / VB для приложений

Здесь мы ответим на действительно интересные вопросы:

Как узнать, установлен ли Word 8 на машине клиента?

Где расположены шаблоны?

Почему запускается все время новый документ, когда я хочу работать в том же?

Как найти документ, с которым пользователь работал в последнее время?

Почему Word закрывается после завершения моей процедуры?

Как мне добраться до папок программы Outlook?

Как в Outlook получить доступ к существующему контакту или создать свой?

{--------------------Взято из библиотеки типов--------------- WORDDEC.INC}
Const
// OlAttachmentType
olByValue = 1;olByReference = 4;olEmbeddedItem = 5;olOLE = 6;// OlDefaultFolders
olFolderDeletedItems = 3;olFolderOutbox = 4;olFolderSentMail = 5;olFolderInbox = 6;olFolderCalendar = 9;olFolderContacts = 10;olFolderJournal = 11;olFolderNotes = 12;olFolderTasks = 13;// OlFolderDisplayMode
olFolderDisplayNormal = 0;olFolderDisplayFolderOnly = 1;olFolderDisplayNoNavigation = 2;// OlInspectorClose
olSave = 0;olDiscard = 1;olPromptForSave = 2;// OlImportance
olImportanceLow = 0;olImportanceNormal = 1;olImportanceHigh = 2;// OlItems
olMailItem = 0;olAppointmentItem = 1;olContactItem = 2;olTaskItem = 3;olJournalItem = 4;olNoteItem = 5;olPostItem = 6;// OlSensitivity
olNormal = 0;olPersonal = 1;olPrivate = 2;olConfidential = 3;// OlJournalRecipientType;
olAssociatedContact = 1;// OlMailRecipientType;
olOriginator = 0;olTo = 1;olCC = 2;olBCC = 3;
Const
wdGoToBookmark = -1;wdGoToSection = 0;wdGoToPage = 1;wdGoToTable = 2;wdGoToLine = 3;wdGoToFootnote = 4;wdGoToEndnote = 5;wdGoToComment = 6;wdGoToField = 7;wdGoToGraphic = 8;wdGoToObject = 9;wdGoToEquation = 10;wdGoToHeading = 11;wdGoToPercent = 12;wdGoToSpellingError = 13;wdGoToGrammaticalError = 14;wdGoToProofreadingError = 15;
wdGoToFirst = 1;wdGoToLast = -1;wdGoToNext = 2; //интересно,wdGoToRelative = 2; //чем отличаются эти две константы?wdGoToPrevious = 3;wdGoToAbsolute = 1;

Основные функции:

Function GetWordUp(StartType : string):Boolean;
Function InsertPicture(AFileName : String) : Boolean;
Function InsertContactInfo(MyId : TMyId; MyContId : TMyContId): Boolean;
Function GetOutlookUp(ItemType : Integer): Boolean;
Function MakeOutLookContact(MyId : TMyId; MyContId : TMyContId) : Boolean;
Function ImportOutlookContact : Boolean;
Function GetOutlookFolderItemCount : Integer;
Function GetThisOutlookItem(AnIndex : Integer) : Variant;
Function FindMyOutlookItem(AFilter : String; var AItem : Variant) :Boolean;
Function FindNextMyOutlookItem(var AItem : Variant) : Boolean;
Function CloseOutlook : Boolean;

Type TTreeData = class(TObject)
PublicItemId : String;end;

<
/p> Как использовать весь этот код?
Вот модуль для работы с Контактами программы Outlook.
Строим расширенный список контактов ( компонент TExtListView вы можете найти на ).

unit UImpContact;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,UMain, StdCtrls, Buttons, ComCtrls, ExtListView;
type
TFindContact = class(TForm)ContView1: TExtListView;SearchBtn: TBitBtn;CancelBtn: TBitBtn;procedure SearchBtnClick(Sender: TObject);procedure CancelBtnClick(Sender: TObject);procedure ContView1DblClick(Sender: TObject);procedure FormCreate(Sender: TObject);procedure FormClose(Sender: TObject; var Action: TCloseAction);private{ Private declarations }public{ Public declarations }end;
var
FindContact: TFindContact;
implementation
Uses USearch;

{$R *.DFM}

procedure TFindContact.SearchBtnClick(Sender: TObject);
begin
If ContView1.Selected <> nil thenContView1DblClick(nil);end;

procedure TFindContact.CancelBtnClick(Sender: TObject);
begin
CloseOutlook;ModalResult := mrCancel;end;

procedure TFindContact.ContView1DblClick(Sender: TObject);
var MyContact : variant;
begin
If ContView1.Selected <> nil then BeginMyContact := GetThisOutlookItem(StrToInt(ContView1.Selected.subitems[2]));With StartForm.MyId doIf Not GetData(MyContact.CustomerId) then beginInitData;If MyContact.CustomerId <> '' thenId := MyContact.CustomerIdElseId := MyContact.CompanyName;If DoesIdExist(Startform.MyId.Id) then beginWarning('Дескриптор данных', 'Не могу установить уникальный Id' + CRLF+ 'Отредактируйте CustomerId в Outlook и попытайтесь снова');CloseOutlook;ModalResult := mrCancel;Exit;end;OrganizationName := MyContact.CompanyName;IdType := 1;AccountId := MyContact.Account;Address1 := MyContact.BusinessAddressStreet;City := MyContact.BusinessAddressCity;StProv := MyContact.BusinessAddressState ;Postal := MyContact.BusinessAddressPostalCode;Country := MyContact.BusinessAddressCountry;Phone := MyContact.CompanyMainTelephoneNumber;Insert;end;With StartForm.MyContId do beginInitData;ContIdId := StartForm.MyId.Id;Honorific := MyContact.Title ;FirstName := MyContact.FirstName ;MiddleInit := MyContact.MiddleName ;LastName := MyContact.LastName ;Suffix := MyContact.Suffix ;Fax := MyContact.BusinessFaxNumber ;WorkPhone := MyContact.BusinessTelephoneNumber;HomeFax := MyContact.HomeFaxNumber ;HomePhone := MyContact.HomeTelephoneNumber ;MobilePhone := MyContact.MobileTelephoneNumber ;OtherPhone := MyContact.OtherTelephoneNumber ;Pager := MyContact.PagerNumber ;Email := MyContact.Email1Address ;Title := MyContact.JobTitle;OfficeLocation := MyContact.OfficeLocation ;Insert;End;end;CloseOutlook;
ModalResult := mrOk;

end;

procedure TFindContact.FormCreate(Sender: TObject);
var MyContact : Variant;
MyCount : Integer;i : Integer;AnItem : TListItem;begin
If not GetOutlookUp(OlContactItem)then exit;MyCount := GetOutlookFolderItemCount ;For i := 1 to MyCount do beginMyContact := GetThisOutlookItem(i);AnItem := ContView1.Items.Add;AnItem.Caption := MyContact.CompanyName;AnItem.SubItems.add(MyContact.FirstName);AnItem.Subitems.Add(MyContact.LastName);AnItem.SubItems.Add(inttostr(i));End;
end;

procedure TFindContact.FormClose(Sender: TObject;
var Action: TCloseAction);begin
Action := cafree;end;

end.

[000187]

Содержание раздела