Send Mail VBA

[jbcmarine]

Hello all -

I am trying to run a module from a command button that will allow a user to email a file. Below is what I have so far:

Please Login or Register  to view this content.

Please Login or Register  to view this content.

When I try and execute from a command button I get a Compile Error: User-defined type not defined on the Sub SendMessage (highlighted in yellow) and the next line Dim objOutlook As Outlook.Application.

I am very new to VBA and cannot figure this out. I copied this code from an example I found online but can't get it to run for me.

I have attached the file I am working with, if anyone could assist it would be greatly appreciated!

[Pepe Le Mokko]

http://www.rondebruin.nl/win/addins/rdbmail.htm

[jbcmarine]

I am now able to get module to call up Outlook, attach the desired file, enter information in the subject line and in the body; however, I cannot get the module to populate the To: field:

Sub CallMailer()

Dim lngLoop As Long 'Programming ethics 1. Always start your first line after leaving a line space, and 1 indentation level

With ActiveSheet
For lngLoop = 2 To .Cells(Rows.Count, 1).End(xlUp).Row ' Programming ethics 3. Always indent your loops, case statements and with constructors
Call SendMessage(strTo:=.Cells(lngLoop, 1).Value, strCC:=.Cells(lngLoop, 2).Value, strBCC:=.Cells(lngLoop, 7).Value, strMessage:=.Cells(lngLoop, 8).Value, strSubject:=.Cells(lngLoop, 3).Value, strAttachmentPath:=.Cells(lngLoop, 6).Value)
Next lngLoop
End With 'Programming ethics 2. Always end your last line leaving a line space before ending the sub or function, and having indendation level of 1

End Sub

Sub SendMessage(strTo As String, Optional strCC As String, Optional strBCC As String, Optional strSubject As String, Optional strMessage As String, Optional strAttachmentPath As String, Optional blnShowEmailBodyWithoutSending As Boolean = False)

Dim objOutlook As Object
Dim objEmail As Object
Dim objOutlookMsg As Object
Dim objOutlookRecip As Object

If Trim(strTo) & Trim(strCC) & Trim(strBCC) = "" Then
MsgBox "Please provide a mailing address!", vbInformation + vbOKOnly, "Missing mail information"
Exit Sub
End If
' Create the Outlook session.
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
Err.Clear: On Error GoTo -1: On Error GoTo 0
If objOutlook Is Nothing Then
Set objOutlook = CreateObject("Outlook.Application")
End If

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
' Add the To recipient(s) to the message.
If Trim(strTo) <> "" Then
Set objOutlookRecip = .Recipients.Add(strTo)
objOutlookRecip.Type = olTo
End If

' Add the CC recipient(s) to the message.
If Trim(strCC) <> "" Then
Set objOutlookRecip = .Recipients.Add(strCC)
objOutlookRecip.Type = olCC
End If

' Add the BCC recipient(s) to the message.
If Trim(strBCC) <> "" Then
Set objOutlookRecip = .Recipients.Add(strBCC)
objOutlookRecip.Type = olBCC
End If

' Set the Subject, Body, and Importance of the message.
If strSubject = "" Then
strSubject = "This is a Test email"
End If
.Subject = strSubject
If strMessage = "" Then
strMessage = "Test ." & vbCrLf & vbCrLf
End If
.Body = strMessage & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance

' Add attachments to the message.
If Not IsMissing(strAttachmentPath) Then
If Len(Dir(strAttachmentPath)) <> 0 Then
Set objOutlookAttach = .Attachments.Add(strAttachmentPath)
Else
MsgBox "Unable to find the specified attachment. Sending mail anyway."
End If
End If

For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next

If blnShowEmailBodyWithoutSending Then
.Display
Else
.Save
.Display
End If
End With

Set objOutlook = Nothing
Set objOutlookMsg = Nothing
Set objOutlookAttach = Nothing
Set objOutlookRecip = Nothing

End Sub


Can anyone help me fill in what I'm missing? Thanks in advance!