TITLE:Receiving Internet Email
ISSUE:Multi-value Solutions Jul '98
AUTHOR:Nathan Rector
COMPANY:Natec Systems
EMAIL:nater@northcoast.com
HTTP:www.northcoast.com/~nater/
Last month I talked about creating a program to send internet email from your MultiValue host. This month I’ll cover receiving internet email from your MultiValue host.
The Visual Basic program I’ve included uses the basic functions of Windows Messaging and requires the MultiValue host to process the email. It also only processes the text portion of the email. Any attachments are ignored.
This program requires the Windows Messaging system, also known as the InBox, to be running on the Windows Desktop. Once the InBox has collected the email from the internet mail server, this program extracts it so it can be transferred to the MultiValue host. For more information on setting up the InBox please see last month’s article.
This program writes a text record to the directory C:\mvEmail with the extension of ‘.emr’. The file format is:
To: = the person to receive the email
From: = the person who sent the email
Date: = the date the email was received
Time: = the time the email was received
SUBJECT: = is the subject of the email
Any other text that doesn’t have these keywords is part of the body of your email.
Example:
100.emr
to:nater@northcoast.com
from:solution@northcoast.com
subject:testing new message system
Testing new email program.
If you use Microsoft Exchange for in-office email, this program can also be used to retrieve that type of email.
The filename has no meaning other than it is a unique file name. Once the email files are in the directory, they need to be tranferred to your MultiValue host.
The Visual Basic code in this article will not run by itself. The code supplied is a module that must be called from an existing or new program. The easiest way is to create a VB form with a timer control on it. In the timer control place the following code:
Sub Timer1_Timer()
Call ImportMessages
End Sub
By combining this with the Email Sending program supplied last month, you can do both sending and receiving at the same time. A complete program example using both modules can be downloaded from http://www.northcoast.com/~nater/email.zip This file contains the source code and an executable that uses the routines.
Option Explicit
'======================================================================
' Created By Nathan Rector, 04/14/98
' Natec Systems
'
' The ImportMessages procedure accepts two optional arguments, Foldername and InfoStoreName. This enables the user to import messages
' from only a specified folder in any information store, or messages from all top level folders in either in any information store.
'
' To import messages from all top level folders of all information stores, call the procedure with no arguments:
'
' ImportMessages
'
'
' To import messages from all top level folders of an information store named "My Info Store," call the
' procedure with no FolderName argument and "My Info Store" as the InfoStoreName argument:
'
' ImportMessages , "My Info Store"
'
'======================================================================
Public Type EmailReceiveType
Sender As String
To As String
CC As String
BCC As String
Subject As String
Text As String
DateReceived As Date
DateSent As Date
Importance As String
End Type
Private Function ParseRecipients(objMessage As Object, RecipientType As Integer)
Dim RecipientCount As Long
Dim Recipient As Object
Dim ReturnString As String
' Check a MAPI message for a specific type of recipient and
' return a semicolon delimited list of recipients. For instance, if
' this function is called using the MapiTo constant, this function
' will return a semicolon delimited list of all recipients on the
' 'TO' line of the message.
Set Recipient = objMessage.Recipients(RecipientCount)
For RecipientCount = 1 To objMessage.Recipients.Count
If RecipientType = Recipient(RecipientCount).Type Then
ReturnString = ReturnString & Recipient(RecipientCount).Name & "; "
End If
Next
If Len(ReturnString) > 0 Then
ReturnString = Left(Trim(ReturnString), Len(ReturnString) - 2)
ParseRecipients = ReturnString
Else
ParseRecipients = ""
End If
End Function
Private Sub WriteMessage(objMessage As Object, FolderName As String, InfoStore As String)
Dim RetVal
Dim iString As String
Dim Message As EmailReceiveType
Dim EmailRecName As String
Dim FileHandle As Integer
' this routine is used to write the message to the file.
On Error GoTo ExitSub
' checks to see if this message has been read. If so, then do not
' read again.
If Not objMessage.Unread Then
' item has been read
GoTo ExitSub
End If
' gets the message information
With Message
.Sender = objMessage.Sender.Name
.To = ParseRecipients(objMessage, mapiTo)
.CC = ParseRecipients(objMessage, mapiCc)
.BCC = ParseRecipients(objMessage, mapiBcc)
On Error Resume Next
.Subject = objMessage.Subject
If Err.Number <> 0 Then
.Subject = Null
Err.Clear
End If
.Text = objMessage.Text
If Err.Number <> 0 Then
.Text = Null
Err.Clear
End If
.DateReceived = objMessage.TimeReceived
If Err.Number <> 0 Then
.DateReceived = Null
Err.Clear
End If
.DateSent = objMessage.TimeSent
If Err.Number <> 0 Then
.DateSent = Null
Err.Clear
End If
.Importance = Switch(objMessage.Importance = 0, "Low", objMessage.Importance = 1, "Normal", objMessage.Importance = 2, "High")
End With
' write message
FileHandle = FreeFile
EmailRecName = "c:\mvEmail\" & objMessage.ID & ".emr"
Open EmailRecName For Output As #FileHandle
Print #FileHandle, "To:" & Message.To
Print #FileHandle, "CC:" & Message.CC
Print #FileHandle, "BCC:" & Message.BCC
Print #FileHandle, "From:" & Message.Sender
Print #FileHandle, "Date:" & Message.DateReceived
Print #FileHandle, "DateSent:" & Message.DateSent
Print #FileHandle, "Subject:" & Message.Subject
Print #FileHandle, "Importance:" & Message.Importance
Print #FileHandle, Message.Text
Close #FileHandle
' mark item as read
objMessage.Unread = False
objMessage.Update
ExitSub:
End Sub
Private Sub RetrieveMessage(objInfoStore As Object, FolderName As Variant)
Dim objFoldersColl As Object, objFolder As Object
Dim objMessage As Object, objMessageColl As Object 'Set a Variable equal to the Folders Collection of the InfoStore's
' this routine is used to read the message out of each folder
' and pass it to the WriteMessage routine to be saved
'Top Level Folder. (RootFolder)
Set objFoldersColl = objInfoStore.RootFolder.Folders
With objFoldersColl
Set objFolder = .GetFirst 'Loop through each folder and determine if we're looking for a
'specific folder from which we're importing messages, or all
'folders.
Do While Not objFolder Is Nothing
If objFolder.Name = FolderName Then
' found the info Store. Process a messages in that
' store
Set objMessageColl = objFolder.Messages
With objMessageColl
Set objMessage = .GetFirst
Do While Not objMessage Is Nothing
Call WriteMessage(objMessage, objFolder.Name, objInfoStore.Name)
Set objMessage = .GetNext
Loop
End With
' exit loop. Done with this loop since there is
' nothing more in the store
Exit Do
Else
Set objFolder = .GetNext
End If
Loop
End With
End Sub
Public Sub ImportMessages(Optional InfoStoreName As Variant)
Dim MapiSession As Object
Dim objFoldersColl As Object
Dim objInfoStore As Object
Dim RetVal
' this routine is used to open the session and process each
' personal information store for this profile
Set MapiSession = CreateObject("Mapi.Session")
'In the following line, replace the ProfileName argument with a valid
'profile. If you omit the ProfileName argument, Microsoft Exchange
'will prompt you for your profile.
MapiSession.Logon ProfileName:="MV Solutions"
'Loop through each InfoStore in the MAPI session and determine if we
'should read in messages from ALL InfoStores or just a specified
'InfoStore. InfoStores include a user's personal store files
'(.PST Files), Network stores, and Public Folders.
For Each objInfoStore In MapiSession.InfoStores
If Not IsMissing(InfoStoreName) Then
If objInfoStore.Name = InfoStoreName Then
Call RetrieveMessage(objInfoStore, "Inbox")
Exit For
End If
Else
Call RetrieveMessage(objInfoStore, "Inbox")
End If
Next
MapiSession.Logoff ' Log out of the MAPI session.
Set MapiSession = Nothing
End Sub
SUBROUTINE TEST
*
* this program is used to retrieve email messages from the Windows Email Program
*
OPEN "EMAIL" TO EMAIL.FILE ELSE STOP 201, "EMAIL"
*
CALL PLSUB.INIT ;* as per manual
CALL PLSUB.DSG("OPEN CONNECTION",PLCB.HANDLE,"DSG","","","","","",ERR)
IF ERR # "" THEN GOTO 900
*
CALL PLSUB.DSG("DOS DIR",PLCB.HANDLE,"C:\mvEmail\*.EMS","","","",DIR.LIST,"",ERR)
IF ERR # "" THEN GOTO 900
*
NUM = DCOUNT(DIR.LIST,CHAR(254))
FOR I = 1 TO NUM
*
RW.MODE = "R" ; SH.MODE = "R"
CALL PLSUB.DSG("DOS OPEN",PLCB.HANDLE,"C:\mvEmail\": DIR.LIST<I,1> :".EMS",RW.MODE,SH.MODE,"",FILE.HANDLE,"",ERR)
IF ERR # "" THEN GOTO 900
IF FILE.HANDLE = "" THEN GOTO 900
*
CALL PLSUB.DSG("DOS WRITE",PLCB.HANDLE,FILE.HANDLE,"0","A",EMAIL.ITEM,RESULT,"",ERR)
IF ERR # "" THEN GOTO 900
*
CALL PLSUB.DSG("DOS CLOSE",PLCB.HANDLE,FILE.HANDLE,"","","","","",ERR)
*
WRITE EMAIL.ITEM ON EMAIL.FILE, DIR.LIST<I,1>
NEXT I
*
900*
CALL PLSUB.DSG("CLOSE CONNECTION",PLCB.HANDLE,"","","","","","",ERR)
*
CALL PLSUB.INIT ;* as per manual
END