Issue with Resolving Names

  • Thread starter Thread starter AP
  • Start date Start date
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
 
program is sending to an email address that is a fax server.

Please clarify what you mean by that by providing a typical value strTo.
 
program is sending to an email address that is a fax server.

Please clarify what you mean by that by providing a typical value strTo.

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54



AP said:
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
myDraftsFolder.Items.Item(lDraftItem).Send
End If
End If
Next lDraftItem

Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub- Hide quoted text -

- Show quoted text -

Hello.
Thank you for your response. I figured it out. The code was fine, the
problem was a comma in the address that cause it to think there were
multiple recipients. I replaced the comma with a space because it was
not needed to begin with. Thanks.
 
Back
Top