I found the following code on a website recommened by this newsgroup. Can
any one tell me what I need to add/delete or change to create an input box
for the user to type what should go in the body of the email. Other than
that this works GREAT!

Sub Outlook_Mail_Every_Worksheet()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strdate As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For Each ws In ThisWorkbook.Worksheets
If ws.Range("a1").Value Like "?*@?*.?*" Then
strdate = Format(Now, "dd-mm-yy h-mm-ss")
ws.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Sheet " & ws.Name & " of " _
& ThisWorkbook.Name & " " & strdate & ".xls"
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ws.Range("a1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Set OutMail = Nothing
End If
Next ws
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Hi Jordan

See the VBA help for Application.InputBox

Dim mystr As Variant
mystr = InputBox _
(prompt:="Please enter something ", _
Title:="Hi there")

and use

..Body = mystr



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Jordan" wrote in message ...
I found the following code on a website recommened by this newsgroup. Can
any one tell me what I need to add/delete or change to create an input box
for the user to type what should go in the body of the email. Other than
that this works GREAT!

Sub Outlook_Mail_Every_Worksheet()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strdate As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For Each ws In ThisWorkbook.Worksheets
If ws.Range("a1").Value Like "?*@?*.?*" Then
strdate = Format(Now, "dd-mm-yy h-mm-ss")
ws.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Sheet " & ws.Name & " of " _
& ThisWorkbook.Name & " " & strdate & ".xls"
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ws.Range("a1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Set OutMail = Nothing
End If
Next ws
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Sub Outlook_Mail_Every_Worksheet()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strdate As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For Each ws In ThisWorkbook.Worksheets
If ws.Range("a1").Value Like "?*@?*.?*" Then
strdate = Format(Now, "dd-mm-yy h-mm-ss")
ws.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Sheet " & ws.Name & " of " _
& ThisWorkbook.Name & " " & strdate & ".xls"
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ws.Range("a1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = InputBox("Enter Text for mail: ")
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Set OutMail = Nothing
End If
Next ws
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

--
Regards,
Tom Ogilvy


"Jordan" wrote in message
...
I found the following code on a website recommened by this newsgroup. Can
any one tell me what I need to add/delete or change to create an input box
for the user to type what should go in the body of the email. Other than
that this works GREAT!

Sub Outlook_Mail_Every_Worksheet()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strdate As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For Each ws In ThisWorkbook.Worksheets
If ws.Range("a1").Value Like "?*@?*.?*" Then
strdate = Format(Now, "dd-mm-yy h-mm-ss")
ws.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Sheet " & ws.Name & " of " _
& ThisWorkbook.Name & " " & strdate & ".xls"
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ws.Range("a1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Set OutMail = Nothing
End If
Next ws
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Ron, Thank you very much. It was your orginal code that I used! I dont
know VBA at all and this has been very helpful. Thanks so much.

"Ron de Bruin" wrote:

Hi Jordan

See the VBA help for Application.InputBox

Dim mystr As Variant
mystr = InputBox _
(prompt:="Please enter something ", _
Title:="Hi there")

and use

..Body = mystr



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Jordan" wrote in message ...
I found the following code on a website recommened by this newsgroup. Can
any one tell me what I need to add/delete or change to create an input box
for the user to type what should go in the body of the email. Other than
that this works GREAT!

Sub Outlook_Mail_Every_Worksheet()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strdate As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For Each ws In ThisWorkbook.Worksheets
If ws.Range("a1").Value Like "?*@?*.?*" Then
strdate = Format(Now, "dd-mm-yy h-mm-ss")
ws.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Sheet " & ws.Name & " of " _
& ThisWorkbook.Name & " " & strdate & ".xls"
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ws.Range("a1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Set OutMail = Nothing
End If
Next ws
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Hi Jordan

You can use the inputbox code I posted outside the loop.
This way all people get the same message and you only have to enter in one time.

Tom's example show you how to show the inputbox for every mail.
Another ways is to use
..Display instead of .Send in the code

This way you can enter the text in in the mail




--
Regards Ron de Bruin
http://www.rondebruin.nl


"Jordan" wrote in message ...
Ron, Thank you very much. It was your orginal code that I used! I dont
know VBA at all and this has been very helpful. Thanks so much.

"Ron de Bruin" wrote:

Hi Jordan

See the VBA help for Application.InputBox

Dim mystr As Variant
mystr = InputBox _
(prompt:="Please enter something ", _
Title:="Hi there")

and use

..Body = mystr



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Jordan" wrote in message ...
I found the following code on a website recommened by this newsgroup. Can
any one tell me what I need to add/delete or change to create an input box
for the user to type what should go in the body of the email. Other than
that this works GREAT!

Sub Outlook_Mail_Every_Worksheet()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strdate As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For Each ws In ThisWorkbook.Worksheets
If ws.Range("a1").Value Like "?*@?*.?*" Then
strdate = Format(Now, "dd-mm-yy h-mm-ss")
ws.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Sheet " & ws.Name & " of " _
& ThisWorkbook.Name & " " & strdate & ".xls"
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ws.Range("a1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Set OutMail = Nothing
End If
Next ws
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub