VB6.0 - Office Outlook mail retrieval

[Nightwalker83]

Hi,

This is a Visual Basic 6.0 example I created back in 2005. This example shows you how to use the mapi components in VB to take advantage of Office Outlook (2003)'s email abilities. The MSMapi32.ocx is required in order for the code to work properly.

Code:

frmAttachments

'Copyright 2005 "nightwalker83"
Private Sub cmdAttach_Click()
CDFiles.ShowOpen
txtFile.Text = CDFiles.FileName
LstFiles.AddItem CDFiles.FileName
lblCount.Caption = lblCount.Caption + 1
End Sub
 
Private Sub cmdCancel_Click()
Unload Me
End Sub
 
Private Sub cmdDelete_Click()
For r = 0 To LstFiles.ListCount - 1
LstFiles.RemoveItem (0)
lblCount.Caption = lblCount.Caption - 1
Next r
txtFile.Text = ""
End Sub
 
Private Sub cmdDone_Click()
Me.Hide
End Sub
 
Private Sub Form_Load()
txtFile.Locked = True
End Sub

frmCompose

Private Sub cmdAttach_Click()
'Show attachments.
frmAttachments.Show vbModal, Me
End Sub
 
Private Sub cmdClear_Click()
'Clear all fields.
txtTO.Text = ""
txtSubject.Text = ""
txtBody.Text = ""
End Sub
 
Private Sub cmdClose_Click()
'Unload the form.
Unload Me
End Sub
 
Private Sub cmdSend_Click()
'Check whether or not to save then send the message.
 frmMain.MAPIMessages1.MsgIndex = -1
frmMain.MAPIMessages1.RecipAddress = txtTO.Text
'Double checks that address is valid.
frmMain.MAPIMessages1.ResolveName
frmMain.MAPIMessages1.MsgSubject = txtSubject.Text
frmMain.MAPIMessages1.MsgNoteText = txtBody.Text
'Check for attachments.
If frmAttachments.LstFiles.ListCount <> 0 Then
 For a = 0 To frmAttachments.LstFiles.ListCount - 1
 For S = 1 To (frmAttachments.LstFiles.ListCount)
 sp = Split(frmAttachments.LstFiles.List(a), "\")
 frmMain.MAPIMessages1.AttachmentName = sp(S)
 Next S
 frmMain.MAPIMessages1.AttachmentIndex = (a)
  frmMain.MAPIMessages1.AttachmentPosition = (a)
frmMain.MAPIMessages1.AttachmentPathName = frmAttachments.LstFiles.List(a)
Next a
End If
'Save the message.
If chkSave.Value = 1 Then
frmMain.MAPIMessages1.Save
End If
'Send the message.
frmMain.MAPIMessages1.Send (False)
End Sub

frmMain

Private Sub Form_Load()
Dim itmM As ListItem, MCount As Variant, MsgCount As Variant, COLH As Integer
 
'Logon to your Email account.
MAPISession1.LogonUI = True
'Sign in to your email account.
MAPISession1.SignOn
'Make sure the messages are used in the current session.
MAPIMessages1.SessionID = MAPISession1.SessionID
'Download new mail from inbox.
MAPISession1.DownLoadMail = False
MAPIMessages1.FetchUnreadOnly = True
MAPIMessages1.Fetch
'Sort the messages.
MAPIMessages1.FetchSorted = True
'Check how many messages were received.
MCount = MAPIMessages1.MsgCount
'Show received messages.
For MsgCount = 0 To MCount - 1
Next MsgCount
'Adjusts the index of each column so it can display the correct information.
For COLH = 0 To 2
Set itmM = LstNewMail.ListItems.Add(, , MAPIMessages1.MsgOrigAddress)
COLH = COLH + 1
itmM.SubItems(COLH) = MAPIMessages1.MsgSubject
COLH = COLH + 1
itmM.SubItems(COLH) = MAPIMessages1.MsgDateReceived
Next COLH
frmMain.Caption = frmMain.Caption & " " & "You have " & MsgCount & " new messages!"
frmMain.Show
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
'Sign out of your email account.
MAPISession1.SignOff
End Sub
 
Private Sub mnuAddress_Click()
'Opens the address book.
On Error Resume Next
MAPIMessages1.Show
End Sub
 
Private Sub mnuCompose_Click()
'Compose a new email message.
frmCompose.Show vbModal, Me
End Sub
 
Private Sub mnuExit_Click()
'Exit the application.
Unload Me
End
End Sub
 
Private Sub mnuReadMessages_Click()
'Opens the form so you can read any new emails.
frmRead.Show vbModal, Me
End Sub

frmRead

Private Sub cmdClose_Click()
'Unload the form.
Unload Me
End Sub
 
Private Sub cmdDelete_Click()
'Deletes current message.
frmMain.MAPIMessages1.Delete
txtBody.Text = ""
txtSubject.Text = ""
txtFrom.Text = ""
frmMain.Refresh
End Sub
 
Private Sub Form_Load()
'Locked the text disable the textboxes so they are read only.
txtFrom.Enabled = False
txtSubject.Enabled = False
txtBody.Locked = True
'Get information from the message so it can be read.
txtFrom.Text = frmMain.MAPIMessages1.MsgOrigAddress
txtSubject.Text = frmMain.MAPIMessages1.MsgSubject
txtBody.Text = frmMain.MAPIMessages1.MsgNoteText
'If there are no more messages disable the delete button.
 If frmMain.MAPIMessages1.MsgCount = "0" Then
  cmdDelete.Enabled = False
End If
End Sub

Module1

Public a As Integer
Public Path As String

Nightwalker