I need some help in understanding how to migrate to some kind of newer MAPI support in .NET. I work with Visual Studio 2008 using VB.NET.
All I need is a capability to send out emails generated from within our VB.NET application. Currently I'm using a VB6 compiled module utilizing the old MSMAPI32.OCX. Our VB.Net application just creates a process thread to shell out and pass parameters to the VB6 executable to initiate the email. This has always worked great for us but with the upcoming Office 2010, it no longer works if the user has the 64bit version of the Office installed on their computer. So we really need to see if there is a better '.NET' way of doing this.
I've been doing a lot of research and just keep getting confused with all the different MAPI references since a lot of them seem more like either Outlook addins or just very old articles/projects which I can't get to work.
We would prefer not to go to SMTP since not all of our users/clients have the capability of setting up a SMTP server. We just would like to be able to create and send emails (with attachments) through their existing Outlook setup.
Any help with either links to other messages/projects that would do just this or any kind of 'proper' way of doing this in .NET would be most appreciated.
If needed, here is a basic sample of coding we do in the VB6 application utilizing the MSMAPI32.OCX control. I just need something that could do the same thing and be a little more up to date in coding standards with .NET:
Public Function SendEmail(Optional KillFile As Boolean = False, Optional bNoDialog As Boolean = False) As Boolean
Dim mpsSession As MAPISession
Dim mpmMessage As MAPIMessages
Dim scCount As Integer
Dim msgPos As Integer
Dim I As Integer
Dim aAddress() As String
Dim aFileName() As String
Dim MsgText As String
Dim bBadName As Boolean
Dim nRecpCnt As Integer
Dim sNames As String
Dim f As Integer
Dim sFile As String
Dim sFileName As String
Dim fWait As frmWait
Dim sErrMsg As String
Dim nErrNum As Long
Dim nAttachCnt As Integer
Dim nAttachPos As Long
On Error GoTo ErrHandle
scCount = 1
msgPos = 1
SendEmail = True
'Parse out the To Names
Do While InStr(msgPos, msToName, ";", vbTextCompare) > 0
scCount = scCount + 1
msgPos = InStr(msgPos, msToName, ";", vbTextCompare) + 1
'Check to see if a ";" was at the final character position, if so, delete it.
If msgPos > Len(msToName) Then
msToName = Left$(msToName, msgPos - 2)
scCount = scCount - 1
End If
Loop
'Parse out the CC Names
Do While InStr(msgPos, msCCName, ";", vbTextCompare) > 0
scCount = scCount + 1
msgPos = InStr(msgPos, msCCName, ";", vbTextCompare) + 1
'Check to see if a ";" was at the final character position, if so, delete it.
If msgPos > Len(msCCName) Then
msCCName = Left$(msCCName, msgPos - 2)
scCount = scCount - 1
End If
Loop
'Parse out the BCC Names
Do While InStr(msgPos, msBCCName, ";", vbTextCompare) > 0
scCount = scCount + 1
msgPos = InStr(msgPos, msBCCName, ";", vbTextCompare) + 1
'Check to see if a ";" was at the final character position, if so, delete it.
If msgPos > Len(msBCCName) Then
msBCCName = Left$(msBCCName, msgPos - 2)
scCount = scCount - 1
End If
Loop
Set mpsSession = MAPISession1
Set mpmMessage = MAPIMessages1
mpsSession.LogonUI = False
mpsSession.DownLoadMail = False
mpsSession.SignOn
mpmMessage.SessionID = mpsSession.SessionID
mpmMessage.Compose
mpmMessage.AddressResolveUI = False
nRecpCnt = 0
'Set up the TO list
If msToName <> "" Then
sNames = msToName
aAddress = Split(msToName, ";")
For I = 0 To UBound(aAddress)
If nRecpCnt > 0 Then mpmMessage.RecipIndex = mpmMessage.RecipCount
mpmMessage.RecipDisplayName = aAddress(I)
nRecpCnt = nRecpCnt + 1
Next I
gsToName = msToName
End If
'Set up the CC list
If msCCName <> "" Then
sNames = msCCName
aAddress = Split(msCCName, ";")
For I = 0 To UBound(aAddress)
If nRecpCnt > 0 Then mpmMessage.RecipIndex = mpmMessage.RecipCount
mpmMessage.RecipDisplayName = aAddress(I)
mpmMessage.RecipType = mapCcList
nRecpCnt = nRecpCnt + 1
Next I
End If
'Set up the BCC list
If msBCCName <> "" Then
sNames = msBCCName
aAddress = Split(msBCCName, ";")
For I = 0 To UBound(aAddress)
If nRecpCnt > 0 Then mpmMessage.RecipIndex = mpmMessage.RecipCount
mpmMessage.RecipDisplayName = aAddress(I)
mpmMessage.RecipType = mapBccList
nRecpCnt = nRecpCnt + 1
Next I
End If
If msFileName <> "" Then
If InStr(msFileName, "#^#") > 0 Then
aFileName = Split(msFileName, "#^#")
nAttachCnt = UBound(aFileName) + 1
If nAttachCnt = 1 Then
msFileName = aFileName(0)
Erase aFileName
End If
Else
nAttachCnt = 1
End If
Else
nAttachCnt = 0
End If
mpmMessage.MsgSubject = msSubjectLine
MsgText = msBodyText & vbCrLf & vbCrLf & vbCrLf
nAttachPos = CLng(Len(MsgText))
If nAttachCnt > 0 Then
MsgText = MsgText & String(nAttachCnt + 2, " ")
End If
mpmMessage.MsgNoteText = MsgText
If nAttachCnt > 1 Then
For I = 0 To UBound(aFileName)
mpmMessage.AttachmentIndex = I
mpmMessage.AttachmentPathName = aFileName(I)
mpmMessage.AttachmentPosition = nAttachPos + I
Next I
ElseIf nAttachCnt = 1 Then
mpmMessage.AttachmentPosition = nAttachPos
mpmMessage.AttachmentPathName = msFileName
End If
If bNoDialog Then
Set fWait = New frmWait
'Showing Wait Form'
fWait.Show
fWait.Refresh
mpmMessage.Send False
'Hiding Wait Form
fWait.Hide
Set fWait = Nothing
Else
'Displaying Email Form
mpmMessage.Send True
End If
mpsSession.SignOff
If KillFile And msFileName <> "" Then
On Error Resume Next
Kill msFileName
Err.Clear
End If
Set frmEmail = Nothing
'This is creating a text file so the calling VB.Net will know if it completed successfully
f = FreeFile
sFileName = msAppDataPath & "\EmailRequisition.txt"
sFile = Dir(sFileName)
If Len(sFile) > 0 Then
Open sFileName For Append As f
Print #f, "SUCCESS"
Close #f
End If
Exit Function
ErrHandle:
nErrNum = Err.Number
sErrMsg = Err.Description
f = FreeFile
sFileName = msAppDataPath & "\EmailRequisition.txt"
sFile = Dir(sFileName)
If Len(sFile) > 0 Then
Open sFileName For Append As f
Print #f, "FAILED"
Close #f
End If
If Not fWait Is Nothing Then
fWait.Hide
Set fWait = Nothing
End If
Select Case nErrNum
Case 32014
mpmMessage.Delete 1
MsgBox "Invalid Receipient [" & aAddress(I) & "] amoung: " & sNames
bBadName = True
SendEmail = False
Resume Next
Case 32021
If Left$(Trim$(aAddress(I)), 1) = "=" Then
MsgBox "Error: " & Format(nErrNum) & " - " & sErrMsg, vbOKOnly + vbExclamation, _
"Email Error"
mpsSession.SignOff
SendEmail = False
Else
aAddress(I) = "=" & aAddress(I)
Resume
End If
Case 32005, 32053, 32003
MsgBox "Your Exchange/Outlook is not running." & vbCrLf & _
"Please start it and then try to send the email again.", _
vbOKOnly + vbExclamation, "No Mail Application"
mpsSession.SignOff
SendEmail = False
Case 32001 'User canceled process
SendEmail = False
Resume Next
Case 32026 'Not Supported - This seems to occur if the Security Allow was canceled.
MsgBox "The Email was not sent due to Security Restrictions." & vbCrLf & vbCrLf & _
nErrNum & " - " & sErrMsg, vbOKOnly + vbCritical, "Forecast*21 Message"
Case Else 'default is to let FailSafe handle errors
'stop here, F8 moves to error line
MsgBox "There was an error while emailing ." & vbCrLf & vbCrLf & _
nErrNum & " - " & sErrMsg, vbOKOnly + vbCritical, "Forecast*21 Message"
End Select
If Not fWait Is Nothing Then
fWait.Hide
Set fWait = Nothing
End If
End Function
Submit an article or tip