Sending files through Lotus Notes on XP

[Birdy]

I am trying to send an email from and Access Form through Lotus Notes.

This works without any problem on Windows 98 & Windows 2000, but when I try it on Windows XP, I get the following error message.

This Email could not be sent. Please contact your System Administrator with the following information.

503 Issue RCPT TO: command before DATA command.

I have looked through the code in Access and can find where it adds the To Address, but it all looks to be OK.

Has anyone else had this problem??

 

[seth_belgium]

What code are you using? Not many good ones go around on the net. I have one, we use it under WinXP and it seems to work fine. I do not take credit for this code, someone else made it (Can't remember who...). If you're interested:

'Public Sub SendNotesMail(Subject as string, attachment as string,
'recipient as string, bodytext as string,saveit as Boolean)
'This public sub will send a mail and attachment if neccessary to the
'recipient including the body text.
'Requires that notes client is installed on the system.
Public Sub SendNotesMail(Subject As String, Attachment As String, Recipient As String, BodyText As String, SaveIt As Boolean)
'Set up the objects required for Automation into lotus notes
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    'Start a session to notes
    Set Session = CreateObject("Notes.NotesSession")
    'Next line only works with 5.x and above. Replace password with your password
    
    'Get the sessions username and then calculate the mail file name
    'You may or may not need this as for MailDBname with some systems you
    'can pass an empty string or using above password you can use other mailboxes.
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GETDATABASE("", MailDbName)
     If Maildb.ISOPEN = True Then
          'Already open for mail
     Else
         Maildb.OPENMAIL
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.createdocument
    MailDoc.Form = "Memo"
    MailDoc.sendto = Recipient
    MailDoc.Subject = Subject
    MailDoc.Body = BodyText
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    'Set up the embedded object and attachment and attach it
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        'Fix voor 6.5
        'MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
    'Send the document
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    MailDoc.Send 0, Recipient
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub

Paste it in a module and send mails like this:

SendNotesMail [Subject], [ATTACHMENT PATH], [RECEPIENT ADRESS], [BODY TEXT], [SAVE MAIL? TRUE OR FALSE]

 

[Birdy]

This is the code that I am using.

Like I said, it works in Win 98 & 2000, so I don't want to change it too much.


Public Sub EmailSociety(ToAddress As String, FromAddress As String, Subject As String, BodyText As String)

'Package these files.

Dim strFilename As String
Dim strFilesRemaining As String
Dim intDotPos As Integer
Dim intSpacePos As Integer
Dim recFrontPage As Recordset
Dim recRegionPrintOptions As Recordset
Dim intCatCode As Integer
Dim intStoreCount As Integer
Dim strError As String
Dim lngStoreID As Long
Dim objDistiller As ACRODISTXLib.PdfDistiller
Dim colAttachments As Collection
Dim varFilename As Variant
Dim lngError As Long
Dim varRecipient As Variant
Dim colRecipients As Collection

On Error GoTo Err

DoCmd.Hourglass True
Set recFrontPage = CurrentDb.OpenRecordset("SELECT DISTINCT PLANCODE, CATEGORYNAME, FormattedNOMINALMETERAGE FROM qmakzttblPrintPlans", DB_OPEN_SNAPSHOT)
'Set recRegionPrintOptions = CurrentDb.OpenRecordset("tblRegionPrintSettings", dbOpenSnapshot)
DoCmd.Hourglass False

Set colAttachments = New Collection

If Not recFrontPage.EOF Then
recFrontPage.MoveLast ' There's an overhead on this, but the user wants to display progress, so need RecordCount.....
recFrontPage.MoveFirst

'do something to indicate progress....
Forms("Select Store Report").SetProgressMax recFrontPage.RecordCount
Forms("Select Store Report").SetProgressValue 0
Forms("Select Store Report").ShowProgress
End If

Set objDistiller = New ACRODISTXLib.PdfDistiller

lngStoreID = -1
intCatCode = -1
intStoreCount = 0

m_strPDFDir = Application.CurrentProject.Path & "\PDF\"

' Check for an appropriate subdirectory to use, if there isn't one, then create it
If Dir(m_strPDFDir, vbDirectory) = "" Then
MkDir m_strPDFDir
Else
On Error Resume Next
Kill m_strPDFDir & "*.pdf"
On Error GoTo Err
End If

Do While Not recFrontPage.EOF

DoEvents

' PRN
' strFilename = Dir(m_strPDFDir & recFrontPage("PLANCODE").Value & "_prn.pdf")
strFilename = Dir(m_strPDFDir & recFrontPage("CATEGORYNAME").Value & "_" _
& recFrontPage("FormattedNOMINALMETERAGE").Value & "_prn.pdf")

If strFilename <> "" Then
colAttachments.Add m_strPDFDir & strFilename
Else
' strFilename = m_strPDFDir & recFrontPage("PLANCODE").Value & "_prn.pdf"
strFilename = m_strPDFDir & recFrontPage("CATEGORYNAME").Value & "_" _
& recFrontPage("FormattedNOMINALMETERAGE").Value & "_prn.pdf"
If Dir(g_conPlanFilePath & recFrontPage("PLANCODE").Value & ".prn") <> "" Then
objDistiller.FileToPDF g_conPlanFilePath & recFrontPage("PLANCODE").Value & ".prn", strFilename, ""
If Dir(strFilename) <> "" Then
colAttachments.Add strFilename
End If
End If
End If

' ML
' strFilename = Dir(m_strPDFDir & recFrontPage("PLANCODE").Value & "_ml.pdf")
strFilename = Dir(m_strPDFDir & recFrontPage("CATEGORYNAME").Value & "_" _
& recFrontPage("FormattedNOMINALMETERAGE").Value & "_ml.pdf")
If strFilename <> "" Then
colAttachments.Add m_strPDFDir & strFilename
Else
' strFilename = m_strPDFDir & recFrontPage("PLANCODE").Value & "_ml.pdf"
strFilename = m_strPDFDir & recFrontPage("CATEGORYNAME").Value & "_" _
& recFrontPage("FormattedNOMINALMETERAGE").Value & "_ml.pdf"
If Dir(g_conPlanFilePath & recFrontPage("PLANCODE").Value & ".ml") <> "" Then
objDistiller.FileToPDF g_conPlanFilePath & recFrontPage("PLANCODE").Value & ".ml", strFilename, ""
If Dir(strFilename) <> "" Then
colAttachments.Add strFilename
End If
End If
End If

' FL
' strFilename = Dir(m_strPDFDir & recFrontPage("PLANCODE").Value & "_fix.pdf")
strFilename = Dir(m_strPDFDir & recFrontPage("CATEGORYNAME").Value & "_" _
& recFrontPage("FormattedNOMINALMETERAGE").Value & "_fix.pdf")

If strFilename <> "" Then
colAttachments.Add m_strPDFDir & strFilename
Else
' strFilename = m_strPDFDir & recFrontPage("PLANCODE").Value & "_fix.pdf"
strFilename = m_strPDFDir & recFrontPage("CATEGORYNAME").Value & "_" _
& recFrontPage("FormattedNOMINALMETERAGE").Value & "_fix.pdf"
If Dir(g_conPlanFilePath & recFrontPage("PLANCODE").Value & ".fix") <> "" Then
objDistiller.FileToPDF g_conPlanFilePath & recFrontPage("PLANCODE").Value & ".fix", strFilename, ""

If Dir(strFilename) <> "" Then
colAttachments.Add strFilename
End If
End If
End If


RetryNext: ' Label for gotos in Err block.
On Error GoTo Err
recFrontPage.MoveNext
Forms("Select Store Report").ProgressStepIt

Loop

Set objDistiller = Nothing

Connect cHostIP_Society, cUserID_Society, lngError

' Send an email to the entered addresses with the appropriate attachments
CreateEmail FromAddress, Subject, BodyText, lngError

'<<< 12-Jan-2004, CSS

'AddRecipient ToAddress

For Each varRecipient In colRecipients
AddRecipient varRecipient
Next varRecipient

For Each varFilename In colAttachments
AddAttachment varFilename, lngError
Next varFilename
Set colRecipients = GetRecipients(ToAddress)
'<<< CSS end

Send lngError

Disconnect

' Tidy up
Forms("Select Store Report").ShowProgress IsShown:=False
Forms("Select Store Report").Refresh

recFrontPage.Close

Set objDistiller = Nothing

DoCmd.SetWarnings True

Exit Sub

Err:

strError = "An error has occured during the creation of this email."
strError = strError + vbCrLf + "Error Number: " + str$(Err.Number) + vbCrLf + Err.Description
strError = strError + vbCrLf + "If this error has been rectified, then Retry the job."
Select Case MsgBox(strError, vbAbortRetryIgnore, "Print Error")
Case vbRetry
' Retry the error line
On Error GoTo Err
Resume

Case vbIgnore
' Try the next one
Err.Clear
Resume RetryNext

Case vbAbort
' Display the error
RaiseError "basEPlans.EmailSociety"

End Select

' Tidy up, and exit.
DoCmd.SetWarnings True
Set objDistiller = Nothing
Disconnect

Forms("Select Store Report").ShowProgress IsShown:=False
Forms("Select Store Report").Refresh

If Not recFrontPage Is Nothing Then recFrontPage.Close
End Sub

'<<< 12-Jan-2004, CSS


Private Function GetRecipients(ToAddress As String) As Collection

Dim strAddresses As String
Dim colRecipients As Collection
Dim lngPosition As Long
Dim strRecipient As String

On Error Resume Next

Set colRecipients = New Collection

' Tidy up the ToAddress string
strAddresses = Replace(ToAddress, vbCr, "")
strAddresses = Replace(strAddresses, vbLf, "")

' Look for a ; in the data
lngPosition = InStr(strAddresses, ";")

While lngPosition > 0

strRecipient = Left(strAddresses, lngPosition - 1)
colRecipients.Add strRecipient
strAddresses = Mid(strAddresses, lngPosition + 1)

lngPosition = InStr(strAddresses, ";")
Wend

If strAddresses <> "" Then colRecipients.Add strAddresses

Set GetRecipients = colRecipients

End Function
'<<< CSS end

 

[seth_belgium]

Sorry, can't help you out on that one. Hope someone else can!

Seth