Attempting to send mail from within Access; get no errors, but no mail either

[J Bard]

Attempting to send mail from within Access; get no errors, but no mail
either

Private Sub Command0_Click()
Dim oa As Outlook.Application
Dim ns As Outlook.NameSpace
Dim mi As Outlook.MailItem

Set oa = New Outlook.Application
Set ns = oa.GetNamespace("mapi")
Set mi = oa.CreateItem(olMailItem)

'mi.To = "(e-mail address removed)"
'mi.To = "(e-mail address removed)"
mi.To = "(e-mail address removed)"
mi.Subject = "test"
mi.Body = "a test"
mi.Send
MsgBox "sending mail please wait"


Set oa = Nothing
Set ns = Nothing
Set mi = Nothing


End Sub

 

[Philippe Oget]

I do not know the cause of your problem ( although I do not use your: ns As
Outlook.NameSpace), but you might be able to work it out against the code I
currently use in one of my databases:

Note: the MoveToOutBoxFolder sub is used to bypass a security restriction in
MS Outlook, which meant that I had to allow each message
being sent, which quite obviously defeated the purpose of automating the
creation of the Emails in the 1st place.

Hope that helps

Philippe Oget

Function SendMail(Optional EmailAddressTo, Optional EmailAddressBCC, _
Optional BodyText, Optional FileToAttach, _
Optional AttachmentTitle, Optional CounterNo, _
Optional MessageTitle)

Dim myOlApp, MyItem, myAttachment
Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItem(olMailItem)
With MyItem
.To = EmailAddressTo
.BCC = EmailAddressBCC
.Subject = MessageTitle
.Body = Chr(13) & Chr(13) & BodyText
End With

'myItem.Display

On Error Resume Next
If FileToAttach <> "" Then
Debug.Print "FileToAttach: " & FileToAttach & " -
AttachmentTitle: " & AttachmentTitle & " - CounterNo " & CounterNo
Set myAttachment = MyItem.Attachments
myAttachment.Add FileToAttach, , 2, AttachmentTitle
End If

With MyItem
'.Send
.Save
.Close
'.MoveTo MyOutBoxFolder
End With

DoEvents
Sleep 500
Set myOlApp = Nothing
Set MyItem = Nothing
Set myAttachment = Nothing

MoveToOutBoxFolder

End Function

Sub MoveToOutBoxFolder()
'FolderTypeEnum Required Long.
'The type of default folder to return.
'Can be one of the following OlDefaultFolders constants:
'olFolderCalendar(9), olFolderContacts(10), olFolderDeletedItems(3),
'olFolderDrafts(16), olFolderInbox(6), olFolderJournal(11),
'olFolderNotes(12), olFolderOutbox(4), olFolderSentMail(5), or
olFolderTasks(13).

On Error GoTo Err
Dim myOlApp
Dim myNameSpace
Dim MyDraftsFolder, MyOutBoxFolder
Dim MyItems, MyItem
olFolderDrafts = 16
olFolderOutbox = 4

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNameSpace("MAPI")
Set MyDraftsFolder = myNameSpace.GetDefaultFolder(olFolderDrafts)
Set MyItems = MyDraftsFolder.Items
Set MyOutBoxFolder = myNameSpace.GetDefaultFolder(olFolderOutbox)
For Each MyItem In MyItems
'MyItem.Display
MyItem.Move MyOutBoxFolder
Next
Err:
If Err <> 0 Then
MsgBox Err & Chr(13) & Chr(13) _
& Err.Description
End If

End Sub