You asked for it. The error occurs in the 5th line of the ChangeReplyAddrNoPrompt() function.
Private Sub Confirmed_Click()
If Me.Confirmed = True Then
Me.DateLocalConfirmed = Date
wantsnotification = DLookup("WantsEmail", "tblCustomers", "CustID = " & Me.CustID)
If wantsnotification = True Then
emailaddress = DLookup("Email", "tblCustomers", "CustID = " & Me.CustID)
message = "Your " & Me.OrderType & " order has been confirmed. The work will be completed on " & Me.DueDate & "."
fctnOutlook "custservice@gtb.net", emailaddress, , , "Order Confirmation", message, , 1, False
End If
Else
Me.DateLocalConfirmed = ""
End If
Function fctnOutlook(Optional FromAddr, Optional Addr, Optional CC, Optional BCC, _
Optional Subject, Optional MessageText, Optional Vote As String = vbNullString, _
Optional Urgency As Byte = 1, Optional EditMessage As Boolean = True)
' Code sample from Accessory
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Set objOutlook = CreateObject("Outlook.Application"

Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Dim colReplyRecips As Recipients
Dim objReplyRecip As Recipient
With objOutlookMsg
If Not IsMissing(FromAddr) Then
.SentOnBehalfOfName = FromAddr
ChangeReplyAddrNoPrompt
End If
If Not IsMissing(Addr) Then
Set objOutlookRecip = .Recipients.Add(Addr)
objOutlookRecip.Type = olTo
End If
If Not IsMissing(CC) Then
Set objOutlookRecip = .Recipients.Add(CC)
objOutlookRecip.Type = olCC
End If
If Not IsMissing(BCC) Then
Set objOutlookRecip = .Recipients.Add(BCC)
objOutlookRecip.Type = olBCC
End If
If Not IsMissing(Subject) Then
.Subject = Subject
End If
If Not IsMissing(MessageText) Then
.Body = MessageText
End If
If IsNull(Vote) = False Then
.VotingOptions = Vote
End If
Select Case Urgency
Case 2
.Importance = olImportanceHigh
Case 0
.Importance = olImportanceLow
Case Else
.Importance = olImportanceNormal
End Select
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
If EditMessage Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Function
Sub ChangeReplyAddrNoPrompt()
Dim objApp As Application
Dim objItem As MailItem
Dim strRecipName As String
Set objApp = CreateObject("Outlook.Application"

Set objItem = objApp.ActiveInspector.CurrentItem
' ### USER OPTION - specify reply address ###
strRecipName = "custservice@gtb.net"
If objItem.Class = olMail And _
objItem.Sent = False Then
Call AddReplyRecip(objItem, strRecipName)
End If
Set objItem = Nothing
Set objApp = Nothing
End Sub
Private Sub AddReplyRecip(objMsg As MailItem, strName As String)
Dim colReplyRecips As Recipients
Dim objReplyRecip As Recipient
Dim strPrompt As String
Dim intRes As Integer
Dim strRecipName As String
Set colReplyRecips = objMsg.ReplyRecipients
Set objReplyRecip = colReplyRecips.Add(strName)
objReplyRecip.Resolve
If Not objReplyRecip.Resolved Then
objReplyRecip.Delete
strPrompt = Quote(strName) & " could not be resolved as " & _
"a valid Outlook address. Do you want to try " & _
"a different name?"
intRes = MsgBox(strPrompt, _
vbYesNo + vbQuestion + vbDefaultButton1, _
"Try Again?"

If intRes = vbYes Then
strRecipName = GetReplyAddress(objMsg)
If strRecipName <> "" Then
Call AddReplyRecip(objMsg, strRecipName)
End If
End If
End If
Set colReplyRecips = Nothing
Set objReplyRecip = Nothing
End Sub