VBA modification for IMAP email accont
Does anyone know how would you modify the following macro to go to your IMAP
folder to be sent instead of your Outbox? My IMAP account has no outbox and it winds up in an email account that has not even been set 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 end summary." & vbNewLine & _ " " & vbNewLine & _ "Phone: 555-5555 or Email " & 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 Sub billy2willy View Public Profile Send a private message to billy2willy Find all posts by billy2willy Add billy2willy to Your Buddy List |
Hi Rob
Never work with IMAP but maybe you can use http://www.rondebruin.nl/cdo.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Rob" wrote in message ... Does anyone know how would you modify the following macro to go to your IMAP folder to be sent instead of your Outbox? My IMAP account has no outbox and it winds up in an email account that has not even been set 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 end summary." & vbNewLine & _ " " & vbNewLine & _ "Phone: 555-5555 or Email " & 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 Sub billy2willy View Public Profile Send a private message to billy2willy Find all posts by billy2willy Add billy2willy to Your Buddy List |
All times are GMT +1. The time now is 03:32 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com