VBA modification for IMAP email accont

[Rob]

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 [email protected]" & 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

[Ron de Bruin]

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" <[email protected]> wrote in message news:[email protected]...
> 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 [email protected]" & 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
>
>
>