10/21/95

Dear Computer Programmer:

(If you are using notepad, turn on wordwrap)

I have attached below some sample code for using OLE Messaging in Win95.  There are several reasons to use OLE Messaging.
	*  It is easy and intuitive
	*  It will support MAPI 0(simple mapi), now and will later support Mapi 1(Extended mapi) without making code changes.  In fact, as I was developing an application using OLE Messaging, I found a number of times that I would get a warning message that would tell me that the service I was trying to use was still under construction.  However, I used this during the Exchange and Win95 beta period and things may be more complete now.
	*  You can do much more with OLE than you can with Mapi.  You can do things in Ole Messaging and vb that you would have to write a custom .dll to use in vb any other way.

	You will have to "turn on" Ole Messaging in your Win95 system by running a batch file called OLEMess.bat.  This file is located in the Winext forum on Compuserve in the Mapi beta forum.  This file and other documentation should be also be available in the Win95 sdk.

	I have not used the code below in several months and it has been changed to prevent me from violating my agreement with my client.  However, the functional parts of the code remain and I have used this code to generate mail to tens of thousands of users using Exchange and also to process thousands of mail responses.  It worked beautifully.  You may be able to improve upon it (use the NEW keyword for example) and I encourage you to do so.

	NOTE:  the code is not for the beginner.  It uses User Defined Types and other programming techniques that are not for the beginner.  In addition, I have not included all the functions that are called but that have nothing to do with OLE Messaging (GetFileName for example).  However, for the experienced developer, these code snips should help get you started -- and that is the only reason I have posted them here.


	Finally, I am a full time developer working for several clients.  I typically spend between 50 and 80 hours per week in billable time.  Therefore, I do not have a great deal of time to offer support.  If you have a quick question, shoot it to me and I will answer if I have the time (and the knowledge).  However, if I don't answer you, don't get your feathers ruffled.  Good luck.

Bruce Jackson 
BruceJackson@MSN.com
71564.1711


Sub SendMessages()
'************************************************************************************************
' PURPOSE:      To begin an OLE sesssion and retrieve messages and their data
' EFFECTS:
' INPUTS:
' RETURNS:
' CALLED FROM:
' AUTHOR DATE:  Bruce Jackson
'************************************************************************************************
On Error GoTo SendMessages_err
Dim cntr As Integer                 ' COUNTER
Dim strSubject As String            ' hold the Subject after Trim
'DIM THE OBJECTS                    ' ALL OF THESE ARE OLE OBJECTS OR COMPONENTS
'---------------
Dim objSession As Object            ' mapi object
Dim objMessage As Object            ' mapi message
Dim objRecip As Object              ' recipient
Dim objAttach
    
    'LOGON IF NOT ALREADY LOGGED ON
    If objSession Is Nothing Then
        Set objSession = CreateObject("MAPI.Session")
        objSession.LogOn profileName:="MS Exchange Settings"  'use Exchange's default setting, this will prevent login dialog
    End If
    
    'CREATE MESSAGE
    Set objMessage = objSession.Outbox.Messages.Add      'create message in outbox
    
        With objMessage
            .Text = mstrMessage
            .Subject = mstrSubject

        'ADD ATTACH
            If gintAttachFlag Then
                For cntr = 1 To UBound(mudtAttach)
                    Set objAttach = .Attachments.Add               ' add attachment
                        With objAttach
                            .Name = GetFileName(mudtAttach(cntr).strFilePath)
                            .Type = 2                              ' attachment is link to file
                            .Position = mudtAttach(cntr).intPosition
                            .Source = gstrDirectoryName & mudtAttach(cntr).strFilePath
                        End With
                 Next cntr
            End If
            
             'CREATE RECIPS
             Set objRecip = objMessage.Recipients.Add
                 With objRecip
                     .Name = Trim$(gudtMsg.strUserId)
                     .Resolve
                     .Type = 1                              ' recipient is on the To: line
                 End With
            .Update
            .send showDialog:=False
        End With
    
    DoEvents           'allow user cancel
        
    Set objMessage = Nothing
    Set objAttach = Nothing
    Set objRecip = Nothing

    ' with ole messaging, there is no special mapi return code, just error messages.  Therefore,
    ' need to send a 0 if success now or 1 if fail
    gintStatusFlag = 0
    
    Open "c:\Log\" & "log" & gstrNewFile & ".txt" For Append As #1
    
'------------------------------------------------------------------------------------------------
SendMessages_bye:
    Write #1, glngTemplateID; glngAccountID; gintStatusFlag
    Close #1
    Exit Sub
SendMessages_err:
    gintStatusFlag = 1
    Open "c:\Log\ErrorLog.txt" For Append As #1
    Write #1, "Error Number: " & Err & ";  Error:  " & Error$
    Resume SendMessages_bye
End Sub

Sub GetMessageData()
'************************************************************************************************
' PURPOSE:      To begin an OLE sesssion and retrieve messages and their data
' EFFECTS:
' INPUTS:
' RETURNS:
' CALLED FROM:
' AUTHOR DATE:  Bruce Jackson
'************************************************************************************************
On Error GoTo GetMessageData_err
Dim udtMessage As Message        'USER DEFINED TYPE:  MESSAGE
Dim cntr As Integer              'COUNTER
Dim strSubject As String         ' hold the Subject after Trim

'DIM THE OBJECTS                 'ALL OF THESE ARE OLE OBJECTS OR COMPONENTS
'---------------
Dim objSession As Object            'mapi object
Dim objMessage As Object            'mapi message
Dim objMessagesColl As Object       'messages collection
Dim objAllFolders As Object         'collection of all folders
Dim objNewFolder As Object          'new folder
Dim strFolderID As String           'string to hold the folder id
Dim objCopyMsg As Object            'new message object that is copied
Dim objSender As Object             'sender object
'SET THE OBJECTS
'----------------
Set objSession = CreateObject("MAPI.Session")
objSession.Logon profileName:="Exchange Settings"  'use Exchange's default setting
Set objAllFolders = objSession.Inbox.Folders
Set objMessagesColl = objSession.Inbox.Messages
Set objMessage = objMessagesColl.GetFirst

    Do While Not objMessage Is Nothing           ' must do it this way so will not initialize objMessage by test
        strSubject = Trim$(objMessage.subject)   ' get the trimmed subject string
        Set objMessage = objMessagesColl.GetFirst 'reset to the start
        Screen.MousePointer = 11  'hourglass

        'LOOP THROUGH ALL MESSAGES, COMPILE ANSWERS AND SEND TO ARVHIVE FOLDER
        '-------------------------------------------------------------------------------------------
           
        'SINCE WE ARCHIVE ALL MESSAGES, DO THIS FOR ALL
        Set objSender = objMessage.Sender
        udtMessage.strSubject = strSubject
        'get VB type date
        udtMessage.varDateReceived = DateFromMapiDate(objMessage.TimeSent)
        udtMessage.strNoteText = objMessage.Text
        udtMessage.strSenderAddress = objSender.address
    
        
        If (Left$(strSubject, 6) = "xxx") Or (Left$(strSubject, 6) = "yyy") Then

            'NOW THAT WE HAVE THE DATA, SEND IT TO THE ACCESS TABLE
            Call SendMailToTable(udtMessage)
            
            'When call SendMail... will set error flag if encounter problem so exit
            If gintErrorFlag Then
                MsgBox "Unexpected error", 16, "Error"
                Exit Sub
            End If
            
            'NOW LET'S MOVE THE MESSAGE TO ANOTHER FOLDER FIRST, GET THE FOLDER'S ID
            '------------------------------------------------------------------------
            Set objNewFolder = objAllFolders.GetFirst
            ' loop through all the folders in the collection
            
            Do While Not objNewFolder Is Nothing
                'must have folder that messages are archived in same as subject name
                If objNewFolder.Name = udtMessage.strSubject Then
                    Exit Do  ' found it, leave the loop
                Else ' keep searching
                    Set objNewFolder = objAllFolders.GetNext
                End If
            Loop
        Else                 'NOT A MESSAGE TO PLACE IN DATABASE, STICK IN "OTHER" FOLDER
            Set objNewFolder = objAllFolders.GetFirst
            Do While Not objNewFolder Is Nothing
                If objNewFolder.Name = "Other" Then
                    Exit Do  ' found it, leave the loop
                Else ' keep searching
                    Set objNewFolder = objAllFolders.GetNext
                End If
            Loop
        End If
        'FOR ALL MESSAGES DO THIS:
        
            'NOW, COPY MESSAGE TO THE NEW FOLDER, IF NO FOLDER THEN ERROR TRAP AND EXIT
            '--------------------------------------------------------------------------
            On Error Resume Next
            Set objCopyMsg = objNewFolder.Messages.Add
            If Err = 91 Then
                MsgBox "You need to create an archive folder with the name: " & udtMessage.strSubject, 16, "Error"
                Exit Sub
            End If
            
            On Error GoTo GetMessageData_err       'RESET ERROR CHECKING
            
            ' archive the message in custom format, want sender info in first line of text for retrieval or lookup later
	    With objCopyMsg
               .subject = strSubject
               .Text = "Sender = " & objSender.address & ":  " & objSender.Name & Chr$(13) & Chr$(10) & objMessage.Text
               .TimeReceived = objMessage.TimeReceived
               .Update
            End With
            'NOW, DELETE READ MESSAGE
            '-------------------------
            objMessage.Delete

            'increment the counter
            cntr = cntr + 1
        Set objMessage = objMessagesColl.GetNext
        DoEvents           'allow user cancel
    Loop
    
    Screen.MousePointer = 0

    'logoff
    objSession.Logoff
    Set objMessagesColl = Nothing
    Set objMessage = Nothing
    Set objAllFolders = Nothing
    Set objSender = Nothing
'------------------------------------------------------------------------------------------------
GetMessageData_bye:
    Exit Sub
GetMessageData_err:
    MsgBox "ERROR: " & Error$ & Chr$(13) & Chr$(10) & "ERR#:  " & Err, 64, "GetMessageData"
    Resume GetMessageData_bye
End Sub


Function DateFromMapiDate(vMapiDate) As Variant
'************************************************************************************************
' PURPOSE:  to format the MAPI date into a date that makes sense to VB
'           MAPI date is in the following format:  YYYY/MM/DD HH:MM
'************************************************************************************************
On Error GoTo DateFromMapiDate_err
Dim strTemp As String
Dim intMarker As Integer
'------------------------------------------------------------------------------------------------
    intMarker = InStr(vMapiDate, Chr$(32))
    vMapiDate = Left$(vMapiDate, intMarker - 1)
    DateFromMapiDate = DateValue(vMapiDate)
'------------------------------------------------------------------------------------------------
DateFromMapiDate_bye:
  Exit Function
DateFromMapiDate_err:
  MsgBox "ERROR: " & Error$ & Chr$(13) & Chr$(10) & "ERR#:  " & Err, 64, "DateFromMapiDate"
  Resume DateFromMapiDate_bye
End Function



Type MessageComponent
    strFieldCode As String
    strMsg As String
    strPath As String
    intMsgMode As Integer
    intPathMode As Integer
    intDisplayOrderMode As Integer
End Type


Type MyMessage
    strMainMessagePath As String              ' path to the directory holding the messages and attachments
    strUserId As String                       ' logon user id
    strFirstName As String                    ' recipient's first name
    strlastName As String                     ' recipient's last name
    udtComponent(20) As MessageComponent      ' user defined type array of components
End Type

Global gudtMsg As MyMessage



Type attach
    intPosition As Integer
    strFilePath As String
End Type

Dim mudtAttach() As attach            '  attachment position array
