Советы по Delphi

         

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]



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