hi all gurus, below is the code to attach the excel file in an email, it is
only attaching one sheet within the document.

How do i get it to attach the entire workbook?

Option Explicit

Sub Button66_Click()

Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim Response As String
Dim DefaultFolder As String, DefaultFileName As String
Dim FileToSave
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Response = MsgBox("Are you sure you want to submit this to Procurement?", _
vbYesNo + vbInformation + vbDefaultButton2)

If Response = vbNo Then

Exit Sub

End If

TempFilePath = Environ$("temp") & "\"

If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

FileExtStr = ".xlsm": FileFormatNum = 52
End If

With Application
..ScreenUpdating = False
.EnableEvents = False
End With

For Each sh In ThisWorkbook.Worksheets
If sh.Range("C21").Value Like "?*@?*.?*" Then

sh.Copy
Set wb = ActiveWorkbook

TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")

If Right(DefaultFolder, 1) < "\" Then
DefaultFolder = DefaultFolder & "\"
End If

DefaultFileName = "Contract Created" & " for " & Sheets("Set Up
Sheet").Range("C12").Value

If Right(UCase(DefaultFileName), 3) < "XLS" Then
DefaultFileName = DefaultFileName & " " & _
Format(Date, "dd-mm-yyyy") & ".xls"
End If

FileToSave = Application.GetSaveAsFilename _
(DefaultFolder & DefaultFileName, filefilter:="Excel Files (*.xls)," _
& "*.xls", Title:="Save File As...")

If FileToSave = False Then
Exit Sub
Else
ThisWorkbook.SaveAs _
Filename:=FileToSave, _
FileFormat:=ActiveWorkbook.FileFormat
End If

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strbody = "Set Up Sheet" & " for " & Sheets("Set Up
Sheet").Range("c12").Value & " " & "has been created"



With wb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
.SendMail sh.Range("c21").Value, _
"This is the Subject line"
On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

End If
Next sh

With Application
.ScreenUpdating = True
.EnableEvents = True
End With



End Sub

I'm sure you'll find assistance in the following link:
http://www.rondebruin.nl/mail/folder1/mail1.htm
Micky


"Neil Holden" wrote:

hi all gurus, below is the code to attach the excel file in an email, it is
only attaching one sheet within the document.

How do i get it to attach the entire workbook?

Option Explicit

Sub Button66_Click()

Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim Response As String
Dim DefaultFolder As String, DefaultFileName As String
Dim FileToSave
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Response = MsgBox("Are you sure you want to submit this to Procurement?", _
vbYesNo + vbInformation + vbDefaultButton2)

If Response = vbNo Then

Exit Sub

End If

TempFilePath = Environ$("temp") & "\"

If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

FileExtStr = ".xlsm": FileFormatNum = 52
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

For Each sh In ThisWorkbook.Worksheets
If sh.Range("C21").Value Like "?*@?*.?*" Then

sh.Copy
Set wb = ActiveWorkbook

TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")

If Right(DefaultFolder, 1) < "\" Then
DefaultFolder = DefaultFolder & "\"
End If

DefaultFileName = "Contract Created" & " for " & Sheets("Set Up
Sheet").Range("C12").Value

If Right(UCase(DefaultFileName), 3) < "XLS" Then
DefaultFileName = DefaultFileName & " " & _
Format(Date, "dd-mm-yyyy") & ".xls"
End If

FileToSave = Application.GetSaveAsFilename _
(DefaultFolder & DefaultFileName, filefilter:="Excel Files (*.xls)," _
& "*.xls", Title:="Save File As...")

If FileToSave = False Then
Exit Sub
Else
ThisWorkbook.SaveAs _
Filename:=FileToSave, _
FileFormat:=ActiveWorkbook.FileFormat
End If

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strbody = "Set Up Sheet" & " for " & Sheets("Set Up
Sheet").Range("c12").Value & " " & "has been created"



With wb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
.SendMail sh.Range("c21").Value, _
"This is the Subject line"
On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

End If
Next sh

With Application
.ScreenUpdating = True
.EnableEvents = True
End With



End Sub