B
billy2willy
Does anyone know how would you modify the following macro to go to you
IMAP folder to be sent instead of your Outbox? My IMAP account has n
outbox and it winds up in an email account that has not even been se
up.
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 = "Month End Summary Report"
.body = "Hi" & vbNewLine & vbNewLine & _
"Please find the attached month en
summary." & vbNewLine & _
" " & vbNewLine & _
"Phone: 555-5555 or Email (e-mail address removed)
& vbNewLine & _
"Cheers"
.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 Su
IMAP folder to be sent instead of your Outbox? My IMAP account has n
outbox and it winds up in an email account that has not even been se
up.
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 = "Month End Summary Report"
.body = "Hi" & vbNewLine & vbNewLine & _
"Please find the attached month en
summary." & vbNewLine & _
" " & vbNewLine & _
"Phone: 555-5555 or Email (e-mail address removed)
& vbNewLine & _
"Cheers"
.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 Su