A
AP
Hello
I am building a program that creates documents in excel and sends them
to the draft folder in outlook. Once everything is in the draft
folder, the user can either review each document or use the following
code to 'send all' Now the problem I am having is that the names
cannot resolve. So even though if I open each email individually and
wait a few seconds, the email address will reappear with an underline
and I can send it manually, I keep getting the outlook does not
recognize names error. Could anyone please give me guidance. This
program is sending to an email address that is a fax server. Here is
the code.
Thanks in advance.
Public Sub SendDrafts()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
'Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookRecip As Object
Dim strTo As String
'Send all items in the "Drafts" folder that have a "To" address filled
'in.
'Setup Outlook Dim oFolder As Outlook.MAPIFolder
Dim oItems As Outlook.Items
Dim oMail As Outlook.MailItem
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder.
Set myDraftsFolder =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then
If Left(Trim(myDraftsFolder.Items.Item(lDraftItem).To), 5) =
"[RFax" Then
'Send Item
strTo = myDraftsFolder.Items.Item(lDraftItem).To
With myDraftsFolder.Items.Item(lDraftItem)
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(strTo)
objOutlookRecip.Type = olTo
'Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
End With
myDraftsFolder.Items.Item(lDraftItem).Send
End If
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
I am building a program that creates documents in excel and sends them
to the draft folder in outlook. Once everything is in the draft
folder, the user can either review each document or use the following
code to 'send all' Now the problem I am having is that the names
cannot resolve. So even though if I open each email individually and
wait a few seconds, the email address will reappear with an underline
and I can send it manually, I keep getting the outlook does not
recognize names error. Could anyone please give me guidance. This
program is sending to an email address that is a fax server. Here is
the code.
Thanks in advance.
Public Sub SendDrafts()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
'Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookRecip As Object
Dim strTo As String
'Send all items in the "Drafts" folder that have a "To" address filled
'in.
'Setup Outlook Dim oFolder As Outlook.MAPIFolder
Dim oItems As Outlook.Items
Dim oMail As Outlook.MailItem
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder.
Set myDraftsFolder =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then
If Left(Trim(myDraftsFolder.Items.Item(lDraftItem).To), 5) =
"[RFax" Then
'Send Item
strTo = myDraftsFolder.Items.Item(lDraftItem).To
With myDraftsFolder.Items.Item(lDraftItem)
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(strTo)
objOutlookRecip.Type = olTo
'Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
End With
myDraftsFolder.Items.Item(lDraftItem).Send
End If
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub