Add Attachment

T

Todd Huttenstine

What code do I need to insert here in order to add an
attachment? The attachment I want to add is C:\Sheets.xls.

Here is the current working code below (it does not send
the attachment)

Private Sub CommandButton2_Click()
Dim cell As Range, cell2 As Range
Dim shRng As Range
Dim sh As Worksheet, sharr() As String
Dim wb As Workbook
Dim i As Integer
Dim objSession As Object, objMessage As Object,
objOneRecip As Object

Set sh = ThisWorkbook.Sheets("Team Management Database")
i = 1


For Each cell In sh.Range("a3", Range("a3").End(xlDown))
Set shRng = cell.Offset(0, 9)
ReDim sharr(1 To shRng.Offset(0, 50).End
(xlToLeft).Column - _
shRng.Column + 1)

For Each cell2 In sh.Range(shRng, shRng.Offset(0,
50).End(xlToLeft))
sharr(i) = cell2.Value
i = i + 1
Next cell2

ThisWorkbook.Sheets(sharr).Copy
Set wb = ActiveWorkbook
wb.SaveAs Filename:="C:\Sheets.xls"
Set objSession = CreateObject("MAPI.Session")
objSession.Logon
Set objMessage = objSession.Outbox.Messages.Add
objMessage.Subject = "Your Stats"

objMessage.Text = "Here are your stats " & cell.Offset(0,
1).Value
Set objOneRecip = objMessage.Recipients.Add
objOneRecip.Name = cell.Offset(0, 2).Value
objOneRecip.Type = 1
objOneRecip.Resolve
objMessage.Send showDialog:=False
objSession.Logoff

wb.Close savechanges:=False
i = 1
Kill "c:\sheets.xls"
Next cell
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Sending emailswith CDO 0
Synax help/ worksheet array 2
Emailing Sheets Code Edit 2
Paste to array of sheets 2
Remove Identical words 0
Searching two ranges 2
Add to existing macro 3
Save Array in memory 5

Top