Help with CDO mail

[Gina K]

I’m using Ron DeBruin’s tips for CDO mail and have had great success so far.
I am not a programmer by any means (I just really enjoy learning and doing
things like this) so please excuse the dumb question…

I’d like to have the user enter the location of a file, the file name, and
extension (i.e. C:\Documents and Settings\My Documents\MyFile.pdf) in a
cell, and have that file sent as an attachment to an e-mail using
AddAttachment.

1. Is this possible? I know you can hard-code a file into the macro, but
can you do it on-the-fly like this? (I tried .AddAttachment
Sheet1.Range("c27").Value but it failed miserably.)
2. Can I attach multiple files this way?
3. Is there some code I can use to open a pop-up window to browse files
(similar to the one that opens when you use Insert > Object)? I’m afraid the
users won’t always enter the correct path and filename.

Thanks very much.

 

[Chip Pearson]

You can prompt the user for the full file name with one dialog:

Dim FName As Variant
FName = Application.GetOpenFilename()
If FName = False Then
' user cancelled
Exit Sub
End If

Now, you have the complete file name in the variable FName which you can use
to attach the file.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[Gina K]

That works great - thanks!
As a follow up question: if I want to attach multiple files, would I use an
FName2, FName3, etc., or is there a better way?

 

[Chip Pearson]

Gina,

If you set the MultiSelect parameter of GetOpenFilename to True, you can
select more than one file from the Open dialog. The selected files will be
returned as an array of individual file names. Thus, you can use code like
the following to test for 0, 1, or many files selected by the user.

Dim FName As Variant
Dim N As Long
Dim OneFName As String

FName = Application.GetOpenFilename(MultiSelect:=True)
If IsArray(FName) Then
For N = LBound(FName) To UBound(FName)
OneFName = FName(N)
' attach file named in OneFName
Debug.Print OneFName
Next N
Else
If FName = False Then
' user cancelled
Debug.Print "User selected 0 files"
Else
Debug.Print "User selected 1 file: " & FName
End If
End If


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[Ron de Bruin]

Try this one

I use MultiSelect in the code now and loop through the array


Sub Test()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim FName As Variant
Dim N As Long
'Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
' .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

With iMsg
Set .Configuration = iConf
.To = "(e-mail address removed)"
.CC = ""
.BCC = ""
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
MultiSelect:=True)
If IsArray(FName) Then
For N = LBound(FName) To UBound(FName)
.AddAttachment (FName(N))
Next
End If
.From = """Ron"" <[email protected]>"
.Subject = "Important message"
.TextBody = strbody
.Send
End With

 

[Ron de Bruin]

I see I not copy the last line
End Sub is missing