Thanks for the reply! Here is the code behind the Word document.
It craps out on the line
Set iMsg = CreateObject("CDO.Message"
Hopefully someone knows whats going on. This is the error it gives:
Run-time error '429'
ActiveX component can't create object
Option Explicit
'declare a record type to break down the user info
Private Type UserRec
bMach(1 To 32) As Byte ' 1st 32 bytes hold machine name
bUser(1 To 32) As Byte ' 2nd 32 bytes hold user name
End Type
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
'Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function
Private Sub cmdSend_Click()
Dim user As Variant
user = fOSUserName()
Dim mail
Dim TestInput As Variant
'Me.TestInput.SetFocus
'TestInput = Me.TestInput.Text
'Me.MailTo.SetFocus
'MailTo = Me.MailTo.Text
'Me.MailFrom.SetFocus
'MailFrom = Me.MailFrom.Text
'Me.MailSubject.SetFocus
'MailSubject = Me.MailSubject.Text
Set mail = Nothing
' Send by connecting to port 25 of the SMTP server.
Dim iMsg
Dim iConf
Dim Flds
Dim strHTML
Const cdoSendUsingPort = 2
Set iMsg = CreateObject("CDO.Message"

Set iConf = CreateObject("CDO.Configuration"
Set Flds = iConf.Fields
' Set the CDOSYS configuration fields to use port 25 on the SMTP server.
With Flds
.Item("
= cdoSendUsingPort
'ToDo: Enter name or IP address of remote SMTP server.
.Item("
= "XONEIDA"
.Item("
= 10
.Update
End With
' Build HTML for message body.
strHTML = "<HTML>"
strHTML = strHTML & "<HEAD>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "<b> </b></br>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"
' Apply the settings to the message.
With iMsg
Set .Configuration = iConf
.To = "mmajewski@alliancebankna.com" 'ToDo: Enter a valid email address.
.From = "PhoneUpdate@AllianceBankna.com" 'ToDo: Enter a valid email address.
.Subject = "Phonebook change for " & Me.txtCurrentName
.HTMLBody = user & "<br><br>" & Me.txtDate & "<br>" & Me.txtCurrentName & " with Title: " & Me.txtCurrentTitle & " at " & Me.txtCurrentBranch.Text & " with phone number: " & Me.txtCurrentPhone & " info has changed to " & "<br>" & vbCr & Me.txtCurrentName & " with Title: " & Me.txtNewTitle & " at " & Me.txtNewBranch.Text & " with phone number: " & Me.txtNewPhone & "." & "<br><br><br>" & Me.txtOther.Text
.Send
End With
MsgBox "Message sent to Matt Majewski! Thank you!"
' Clean up variables.
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
'Me.MailFrom = ""
'Me.MailTo = ""
'Me.MailSubject = ""
'Me.TestInput = ""
End Sub
Private Sub Document_Open()
Me.txtCurrentName.Text = ""
Me.txtCurrentTitle.Text = ""
Me.txtCurrentPhone.Text = ""
Me.txtNewTitle.Text = ""
Me.txtNewPhone.Text = ""
Me.txtCurrentBranch.Text = ""
Me.txtNewBranch.Text = ""
Me.txtOther.Text = ""
Me.txtDate = Date & " " & Time()
End Sub