Solved Error with Outlook code

[Kayleigh]

Hi
I have code in my DB which sends message through outlook. It has worked fine until now - it even seems to be working on most machines but when I try testing it on one computer I get 'error method not supported by this object'. I debugged to find it was the .body = strBody line so when I commented out the line it would create the email but display as a blank window. Any ideas what could have happened here?

Private Sub cmdSend(ByRef recipient As Variant)


Dim db As dao.Database
Dim rs As dao.Recordset
Dim txt As String
Dim varResponse As Variant
Dim varClient As String
Dim varAddress As String

On Error GoTo Err_cmdSend

If IsNothing(Forms!frmorderman!frmOrderLog.Form!fldJLNote) Then
    varResponse = MsgBox("No text found. Would you like to add message?", vbYesNo, gtstrAppTitle)
    If varResponse = vbYes Then
        Exit Sub
    End If
End If

txt = Nz(Forms!frmorderman!frmOrderLog.Form!fldJLNote, "")

DoCmd.Hourglass True

Dim MailList As dao.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim varWhere As Variant
Dim Subjectline As String
Dim strDearName As Variant
Dim signature As String
Dim mail1 As Variant
Dim mail2 As Variant
Dim strBody As String
Dim strClient As String
Dim strTSEmail As Variant
Dim strCompany As Variant
Dim strCompPhone As String
Dim strCompEmail As String
Dim strCompPhone1 As String
Dim strCompEmail1 As String
Dim strCompPhone2 As String
Dim strCompEmail2 As String
Dim rsemail As dao.Recordset
Dim Ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim mySQL As String
Dim varDblGlzRef As Variant
Dim strDescription As String
Dim varX As Variant
varX = Forms!frmlogin!cmbstaff

If Not IsFormLoaded("frmOrderMan") Then Exit Sub

DoCmd.SetWarnings False
Set MyOutlook = New Outlook.Application
Set MyOutlook = CreateObject("Outlook.Application")
Set Ns = MyOutlook.GetNamespace("MAPI")
Set Folder = Ns.GetDefaultFolder(olFolderInbox)
MyOutlook.Explorers.Add Folder

strTSEmail = ""

mail1 = ""

strDearName = ""


If Trim(Forms!frmorderman!fldDblGlzSysRef & "") = "" Then
varDblGlzRef = "No ref"
Else
varDblGlzRef = Nz(Forms!frmorderman!fldDblGlzSysRef)
End If

varClient = Nz(DLookup("cfClient1", "lkpqryclient1", "[fldClientID] = " & Me.Parent.fldAClientID))

varAddress = Nz(DLookup("cfAddress", "lkpqryaddress", "[fldAddressID] =" & Me.Parent.fldOAddressID))


mail1 = recipient


strClient = ""
Subjectline = "JOB LOG: [" & Nz(Me.Parent.fldOrderID, "") & "] " & varDblGlzRef & " - " & Nz(varClient) & " - " & Nz(varAddress) & " - " & Nz(Me.Parent.fldOJobDescription, "")

strBody = txt

Set MyMail = MyOutlook.CreateItem(olMailItem)

With MyMail
    Dim i As Long
    For i = LBound(recipient) To UBound(recipient)
        
        .Recipients.Add (recipient(i))
        
        Dim resolved As Boolean
        resolved = .Recipients.ResolveAll()
        
        If Not resolved Then
            
            MsgBox " Error resolving email addresses"
            Exit Sub
            
        End If
        Next i
        .Subject = CStr(Subjectline)
        
        .Body = CStr(strBody)
        
        If varX = 14 Or IsNothing(varX) Then
            .Display
        Else
            .Send
        End If
    End With
    
Set MyMail = Nothing


Set MyOutlook = Nothing

DoCmd.SetWarnings True
DoCmd.Hourglass False
Dim varZ As Variant
varZ = MsgBox("Message sent successfully", vbInformation + vbOKOnly, gtstrAppTitle)
'debug.Print "done 7"
Exit_cmdSend:
    Exit Sub

Err_cmdSend:
    MsgBox Err.Description, vbExclamation, "cmdSend Error " & Err.Number
    Resume Exit_cmdSend

End Sub

 

[Minty]

Why are you using CStr() to convert a string to string?

Try it with that removed - you have already used an Nz() to make sure an empty string is present.

 

[Kayleigh]

Wow working now. Thanks for your help