I have a VB6 pgm that used to generate outlook e-mails correctly prior to
v2002. Now I need Redemption. I can generate the e-mail but it goes to the
drafts folder and not directly to the Outbox. I can copy from Draft to Outbox
but it is not ready to be sent and needs to be individually entered and sent.
I should be able to generate e-mail directly to the Outbox. What am I doing
wrong?
Using Win2k and XP, Outlook 2k and 2002 - same results.
The following code is a routine called for each e-mail so that there is only
1 To and no cc or bcc per e-mail.
Function CreateMail(xsRecip As Variant, xsSubject As String, xsMsg As
String, _
Optional xsAttachments As String) As Boolean
' Create new e-mail
Dim xvRecip As Variant
Dim xvAttach As Variant
Dim xbResolveOK As Boolean
Dim xnLen As Integer
Dim oMailItem As Object
Dim oMail As Object
Dim myNameSpace As NameSpace
Dim myFolder As Object
Dim SafeItem, oItem
On Error GoTo CreateMail_Err
' Get the message text. If xsMsg=Clipboard, then that is where the text is
If xsMsg = "Clipboard" Then
xsMsg = Clipboard.GetText
End If
xnLen = Len(xsMsg) + 1
Set Application = CreateObject("Outlook.Application")
Set myNameSpace = Application.GetNamespace("MAPI")
myNameSpace.Logon
Set myFolder = myNameSpace.GetDefaultFolder(4) 'olFolderOutbox
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set oItem = Application.CreateItem(olMailItem)
SafeItem.Item = oItem
With SafeItem
.Item = oItem
.Recipients.Add xsRecip
xbResolveOK = .Recipients.ResolveAll
' Note that the attachment must have the full file path. File name alone
isn't good enough!
If Not IsMissing(xsAttachments) And xsAttachments <> "" Then
.Attachments.Add xsAttachments, olByValue, xnLen, "Enclosed file"
End If
.Subject = xsSubject
.Body = xsMsg
If xbResolveOK Then
On Error GoTo 0
.Save
.ExpiryTime = .CreationTime
' .Send
.CopyTo myFolder
Else
MsgBox "Unable to resolve recipient. Please check " & xsRecip
.Display
End If
End With
CreateMail = True
'Set oMailItem = Nothing
'Set orSafeMailItem = Nothing
'Set xgolApp = Nothing
'
CreateMail_End:
Exit Function
CreateMail_Err:
CreateMail = False
Resume CreateMail_End
End Function
|
|