G
Guest
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
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