🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: cn.bbs.comp.program
Article #1070

�VB MAPIʵ��Outlook"���"����

#1070
From: ���ܵ�Сʨ
Date: Thu, 07 May 1998 00:00
142 lines
9321 bytes

  Visual Basic(���¼��VB)��MAPI���ʼ������Ӧ�ó����̽ӿ�
,��ͨ���ʼ�ϵͳ(����:Exchange��Microsoft Mail)������Ϣ�ĺ���
���ϡ�MAPI Ϊ�ͻ��˳�����ʼ�ϵͳ�ṩ������API�ӿڡ�ͨ��ʹ��
MAPIЭ�����Ϣ����,Ӧ�ó�����Ե��÷�ϸ�Э�����Ϣ���ݷ���
��
    VB�������ܹ�ʵ�ֵĹ���ǿ��,���й���Ϣ���ݵı�̷�Ϊ����
����:VB Controls(�ؼ�)��Simple Mapi��OLE Messaging ��ֱ�ӵ�
�� MAPI��VB Controls������Ӧ��,ֻ��ҪΪ�ֳɵ�����������
���Ŀؼ��������Ժ�ʹ��һЩ"����"(Method)������ɼ򵥵ķ��ͺ�
�����ʼ��Ĺ��ܡ�OLE Messaging��΢���ṩ��OLE Messaging�����
,����ʹ�ñ�׼��OLE At omation��������OLE Messaging��������
ϵ,�Ӷ�ʵ���ʼ������Ӧ�á�������˵��һ��MAPI��̬���ӿ�,ֱ��
���� MAPI�����ַ����ṩ���������,Ҳ����ʹ�á�
    ���ǵ�����Ĺ��ܺͽ�������,���Ľ��ܵij�����õ���OLE M
essaging��������ν��"��"��ָOutlook��һ���ļ���(���Ϊ4GB)��
��Ӧ�ó���Ҫʵ�ֵ���:�����ش���ijĿ¼�µ��ļ��Զ��ַ�,����ָ
�������û�Outlook��ָ���IJ�ͬ�ļ����С�
    �������ν���һ��ÿ���ֵ�ʵ���㷨,�����MAPI�ؼ�ֵij�
����롣
    ��Ѱ�ļ�
    Ϊ�˱��ڳ����غ͹���,���ȿ�����VB��һ������,�����ļ���
���������ʵ������ʱ,Ҫ��߳���Ч�ʿ���ȥ�˴��ڡ��ô�����һ
��Ŀ¼�������ı����������ť��ɡ���Ŀ¼��ѡ���ļ�������Դ
��·��;һ���ı�����ʾ���͵��ļ���,��һ���ı�����ʾ���͵��ļ�
����;һ����ť��������,��һ������ȡ�����С���Щ��VB�Ŀؼ�����
��ʵ��,����Ͳ�һһ׸����
    ʵ���ڱ��ش�����Ѱָ��Ŀ¼������Ŀ¼���ļ��Ĺ��Ϊsearch
(filepath),����filp athΪȫ�ֱ���,��������Ŀ¼������ѡ���·
�����ú����ʵ�ֹؼ���ѭ������VB�ĺ���D IR��
    filename = Dir(filepath, vbNormal)   ��filename��ȡ����
���
    Do While filename <> ""
    If filename <> "." And filename <> ".." Then
    �����������ļ���ķ�������ͬ�ļ��С��ֱ�ȡ��filename��
Ӧ���ļ��ı�������IJ����д���
    End If
    filename = Dir
    Loop
    ���ǿ��Ը���ļ���Ĺ̶���ʶ�����,����Case��佫���Ƿ�
����ͬ���ļ���(�����޸�Ҳ�ɴ���ͬ����),�ļ��е������
Ϊ���ݹ��send_doc�IJ���
    �ֱ�ȡ��filename��Ӧ���ļ�����ĺ���Ϊget_title(fullpath
)��get_content(fulp ath) ,����fullpath=filepath & filename��
�����������ֵ���ᴫ��send_doc�е� Mai�ĵ��ú���,Ҳ����ͬʱ
�����ش��ڵ������ı���
    ���send_doc�Ǹó���Ĺؼ�����,������Outlook��Ѱ���ļ���
���ǹؼ�֮�ؼ��������㷨����ʵ���������,����ֱ���Խ���
��

    �޸�Exchange����
    ��һ�ַ������ڷ��������޸�Exchange������,������Ŀ���ļ�
����Ϊ����,Ȼ��ֱ�Ӱ��ļ������objRecip.Name���д��͡�����
�����ĺô��Ǽ�����,�������;ȱ������Ҫ�ı�ϵͳ���á�
    ��Ҫ��������:
    Sub Send_Doc(fullpath, foldername)
     ��foldername��ȫ�ֱ���,����ļ��е�����
     Dim mysession As Object
     Set mysession = CreateObject("mapi.session")  ������һ
��Mapi session����
     If Not mysession IsNothing Then
        mysession.Logon Profilename:="MS Exchange ����"   ��
�������ļ�
     Else
        MsgBox " No session", 16
     End If
     Set objMessage = mysession.Inbox..Messages.Ad  ������һ
��message
     If Not objMessage Is Nothing Then
     objMessage.Text = get_content(fullpath)  �����ĸ�ֵ
     objMessage.Subject = get_title(fullpath)  �����⸳ֵ
     Else
     MsgBox "No Message", 16
     End If
     Set objRecip = objMessage.Recipients.Add������������
     objRecip.Name = foldername
     objRecip.Type = mapiTo
     objRecip.Resolve
     objMessage.Update
     objMessage.Send                ������
     End Sub

    �ݹ��㷨
    �ڶ���ʵ�ַ��������õݹ��㷨��Outlook������Ŀ���ļ��С�
���ַ����ĺô��Dz����޸�ϵͳ����,�׶��dz�������,�㷨��Ը���
�Ѷ��������㷨����Ҫ��������:
    ��Ѱ�Ҹ��ļ���,�ú���ظ��ļ���
    Dim InfoStoresCollIndex As Long
    Set objInfoStoresColl = objsession.InfoStores
    If objInfoStoresColl Is Nothing Then
      MsgBox "Cannot set InfoStores collection"
      Exit Function
    End If
    For InfoStoresCollIndex = 1 To objInfoStoresColl.count
    Set objInfoStore = objInfoStoresColl.Item([InfoStoresCol
lIndex])
    If objInfoStore Is Nothing Then
        MsgBox "Cannot get this InfoStore object"
    End If
    If rootfoldername = objInfoStore.Name Then
        Set objRootFolder = objInfoStore.RootFolder
        If objRootFolder Is Nothing Then
            MsgBox "Error in setting RootFolder"
        End If
        Exit Function
    End IfNext InfoStoresCollIndex���Ը��ļ���Ϊ��,Ѱ��Ŀ
�����
    Dim objFoldersColl As Object
    Dim objOneSubfolder As Object
    If Not objParentFolder Is Nothing Then
      MsgBox ("folder name: " & objParentFolder.Name)
      Set objFoldersColl = objParentFolder.Folders
      If Not objFoldersColl Is Nothing Then
        Set objOneSubfolder = objFoldersColl.GetFirst
        While Not objOneSubfolder Is Nothing
          If (fdname = objOneSubfolder.Name) Then
             Set objFolder = objOneSubfolder
          End If
          x = Util_getobjfolderByname(fdname, objOneSubfolde
r)
               ���ú��������Ŀ���ļ��е�������Ƚ�,���Ŀ��
���
         Set objOneSubfolder = objFoldersColl.GetNext
        Wend
    End IfEnd IfMAPI���ò��ֵij������һ�ַ�������,ֻ����Щ
����Ҫ���ԸĶ�,����n box,���߿����Լ���һ�¡�
    �ó���ʮ��ʵ��,��Ϊһ���ӿڿ�������Ŀ¼�����ϵͳ������
����Ϣ�����ͷַ����ó����������������MAPI�Ĺ���,��Outlook
����Ӧ��������������Զ����Ĺ���,�Ӷ����ǿOutlook������
ϵͳ�ĺ�ͬЭ������������,ֻҪ�����޸�,����������Exchang��,
����ʼ��Զ��ַ�����������ȹ��ܡ�

--
 ________ _____          _____        ______________  _____ 
 ___  __ \___(_)________ ___(_)       __  ___/___  /_ ___(_)
 __  /_/ /__  / ___  __ \__  /        _____ \ __  __ \__  / 
 _  ____/ _  /  __  /_/ /_  /         ____/ / _  / / /_  /  
 /_/      /_/   _  .___/ /_/          /____/  /_/ /_/ /_/   
                /_/                                         

�� ��Դ:���ϴ�С�ٺ���Ϣ����վ bbs.nju.edu.cn��[FROM: hsia.nju.edu.cn]
Technical Details
Message-ID: <3OOYRH$u1E@bbs.nju.edu.cn>
Path: arc1-ca.pugleaf.net!unknown!not-for-mail

Show Full Headers
Complete Article Headers
X-Google-Language: Chinese,GB
X-Google-Thread: fc86e,afaea3c3a5a2dad3,start
X-Google-Attributes: gidfc86e,public
From: pipishi.bbs@bbs.nju.edu.cn (���ܵ�Сʨ)
Subject: �VB MAPIʵ��Outlook"���"����
Date: 1998/05/07
Message-ID: <3OOYRH$u1E@bbs.nju.edu.cn>
X-Deja-AN: 351554917
X-Filename: Programming/M.894547745.A
Organization: nju_bbs
Newsgroups: cn.bbs.comp.program