Need Help : VBA for Ms Outlook

M

mk76

Adept
I need help writing VBA code for following

- I have set a 'Forward as attachment' rule to route all mails from my mailbox at client's server to my company mailbox.
- For all such mails I want to save the attachment(which is actually a mail item) as a separate mail in a folder.

Any code snippets available?
 
mk76 said:
I need help writing VBA code for following

- I have set a 'Forward as attachment' rule to route all mails from my mailbox at client's server to my company mailbox.
- For all such mails I want to save the attachment(which is actually a mail item) as a separate mail in a folder.

Any code snippets available?
Click to expand...

I can help ... but didn't get the part in bold face.

Whatever email you forward .. you want to save them or you want to save the attachments inside those emails to another email ?
 
Thanks.

Let me explain the scenario again.

My client sends me email at mk76@clientsdomain.com. I forward this mail as attachment to mk76@mycompanydomain.com.

So all such mails I recieve from mk76@clientsdomain.com has a mail item as attachment.

I want to save this mail item to a folder. Thus when I will look at it, I will see mail from originalsender@clientsdomain.com with all To,CC list intact.



Why I want to do this. because Exchange 2007 strips CC list if mails are redirected. On the other hand, If I use forward option instead of redirect, I cannot see the actual sender unless I open the mail.

Hope I am able to explain the scenario.

Edit

******************

its not that straight forward as its seems to be! I found this
 
Correct me if wrong..the flow would be like this.

1. You receive a mail in your Outlook client.

2. And auto-rule pushes this mail to an external mail account.

3. VBA within the Outlook client also will save an exact copy of (1) to a .PST folder.

..?
 
Its not that way. To simplify -

1. I receive a mail that has only one attachment of type msg.
2. VBA should copy this msg type attachment as a mail item in 'xyz' folder
So the code model would be
- For any incoming mail
- if its from 'myemailid@clientsdomain.com'
- check attachment count should be 1 and type = msg
- newmailItem = incomingmail.attachment
- move newmailitem to xyz folder

This is what I am looking for.

However I found the following while searching for the solution
In general to work with any attachment you must save it to the file system first. However, importing a MSG file from the file system or dealing with it in any other way in code is not exposed in the Outlook object model.
Click to expand...
This guys also talks about 3rd party library called Redemption - should possibly can be used to achieve this
 
whatever possible... or I can even add a button to run it manually.

These are all secondary issues. The main point is handling msg type attachments. Do you have any workaround?
 
Code: 
Public Sub ProcessInbox()

    Dim oOutlook As Outlook.Application
    Dim oNs As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim oAttachments As Outlook.Attachments
    Dim oAttachment As Outlook.Attachment
    Dim iMsgCount As Integer
    Dim oMessage As Outlook.MailItem
    Dim iCtr As Long, iAttachCnt As Long
    Dim sFileNames As String
    Dim aFileNames() As String

    'get reference to inbox
    Set oOutlook = New Outlook.Application
    Set oNs = oOutlook.GetNamespace("MAPI")
    Set Inbox = oNs.GetDefaultFolder(olFolderInbox)

    Set oFldr = Inbox

    Debug.Print "Total Items: "; Inbox.Items.Count
    Debug.Print "Total Unread items = " & Inbox.UnReadItemCount
    For Each oMessage In Inbox.Items
            With oMessage
                If .Subject = "test mail" Then
                    Debug.Print .To
                    Debug.Print .CC
                    Debug.Print .Subject
                    If .UnRead Then
                        Debug.Print "Message has not been read"
                    Else
                        Debug.Print "Message has been read"
                    End If
                    'reference and save all attachments
                    With oMessage.Attachments
                        iAttachCnt = .Count
                        If iAttachCnt = 1 Then
                            For iCtr = 1 To iAttachCnt
                                .Item(iCtr).SaveAsFile "N:\" & .Item(iCtr).FileName
                                Debug.Print .Item(iCtr).DisplayName
                            Next iCtr
                        End If
                    End With
                End If
            End With
            DoEvents
        Next oMessage
        
        Set oAttachment = Nothing
        Set oAttachments = Nothing
        Set oMessage = Nothing
        Set oFldr = Nothing
        Set oNs = Nothing
        Set oOutlook = Nothing
End Sub

this is stripped version of original code which I wrote for my email filtering purpose

here if subject of email is "test mail" then processing starts ... it checks for one attachment and it's type and then saves it

once message is processed u can move it to outlook datafile too or delete it ... that part is not included here
 
Thanks m8. I have already seen this snippet.

The point is I do not want to save the msg type attachment on disk. Rather I would like them to be copied as mail to inbox.

Modified version of the above which I tested is

Sub copyattachments()

Dim oOutlook As Outlook.Application

Dim oNs As Outlook.NameSpace

Dim oInbox As Outlook.MAPIFolder

Dim oFldr As Outlook.MAPIFolder

Dim oMessage As Object

Dim oMail As MailItem

Dim oNewMail As Object

Dim oAtt As Outlook.Attachment

Dim iCtr As Integer

Dim iAttachCnt As Integer



On Error GoTo ErrHandler



Set oOutlook = New Outlook.Application

Set oNs = oOutlook.GetNamespace("MAPI")

Set oInbox = oNs.GetDefaultFolder(olFolderInbox)

Set oFldr = oInbox.Folders("Copy")

For Each oMessage In oFldr.Items

Set oMail = oMessage

If oMail.SenderEmailAddress = "mk76@clientsdomain.com" Then

iAttachCnt = oMail.Attachments.Count

If iAttachCnt = 1 Then

Set oAtt = oMail.Attachments.Item(1)

oAtt.SaveAsFile "c:\temp\" & oAtt.FileName

Set oNewMail = Outlook.Application.CreateItemFromTemplate("c:\temp\" & oAtt.FileName, oFldr)

oNewMail.Save

oNewMail.Move oFldr

oNewMail.UnRead = True

oMail.Delete

End If

End If

DoEvents



Next oMessage

SaveAttachments = True



ErrHandler:

Set oMessage = Nothing

Set oFldr = Nothing

Set oNs = Nothing

Set oOutlook = Nothing

End Sub
Click to expand...

The catch is Outlook.Application.CreateItemFromTemplate creates a new draft mail instead of a received item.

This is where I am stuck.

Although an interesting point to note is.. if we manually open a mail with MSG type attachment, drag that attachment to a folder, it successfully creates the mail as desired
 
^^

Would it work, if you fire the code from excel. Would hook into the Outlook client, and do what you want. If this is fine, let me know..can give it a shot..? Not that I do not know Outlook model for VBA, but prefer it VIA Excel, keep it independent to the platform.
 
mk76 said:
Thanks m8. I have already seen this snippet.

The point is I do not want to save the msg type attachment on disk. Rather I would like them to be copied as mail to inbox.

Modified version of the above which I tested is

The catch is Outlook.Application.CreateItemFromTemplate creates a new draft mail instead of a received item.
This is where I am stuck.

Although an interesting point to note is.. if we manually open a mail with MSG type attachment, drag that attachment to a folder, it successfully creates the mail as desired
Click to expand...

I'll try to do it tonight ... night shift rocks bcoz I get lots of free time.

asingh said:
^^
Would it work, if you fire the code from excel. Would hook into the Outlook client, and do what you want. If this is fine, let me know..can give it a shot..? Not that I do not know Outlook model for VBA, but prefer it VIA Excel, keep it independent to the platform.
Click to expand...

yup ... all u need to do is create instance of outlook in excel and u r good to go ... both models are very much similar
 
Here is what u need i guess

Code: 
Public Sub ProcessInbox()

    Dim oOutlook As Outlook.Application
    Dim oNs As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder, Drafts As Outlook.MAPIFolder
    Dim oAttachments As Outlook.Attachments
    Dim oAttachment As Outlook.Attachment
    Dim iMsgCount As Integer
    Dim oMessage As Outlook.MailItem, oMessage1 As Outlook.MailItem
    Dim iCtr As Long, iAttachCnt As Long
    Dim sFileNames As String
    Dim aFileNames() As String

    'get reference to inbox
    Set oOutlook = New Outlook.Application
    Set oNs = oOutlook.GetNamespace("MAPI")
    Set Inbox = oNs.GetDefaultFolder(olFolderInbox)
    Set Drafts = oNs.GetDefaultFolder(olFolderDrafts)

    Set oFldr = Inbox

    Debug.Print "Total Items: "; Inbox.Items.Count
    Debug.Print "Total Unread items = " & Inbox.UnReadItemCount
    For Each oMessage In Inbox.Items
            With oMessage
                If .Subject = "test mail" Then
                    Debug.Print .To
                    Debug.Print .CC
                    Debug.Print .Subject
                    If .UnRead Then
                        Debug.Print "Message has not been read"
                    Else
                        Debug.Print "Message has been read"
                    End If
                    'reference and save all attachments
                    With oMessage.Attachments
                        iAttachCnt = .Count
                        If iAttachCnt = 1 Then
                            For iCtr = 1 To iAttachCnt
                                If UCase(Right$(oMessage.Attachments.Item(iCtr).FileName, 3)) = "MSG" Then
                                    .Item(iCtr).SaveAsFile "N:\" & oMessage.Attachments.Item(iCtr).FileName
                                    Set oMessage1 = CreateItemFromTemplate("N:\" & oMessage.Attachments.Item(iCtr).FileName)
                                    Set oMessage1 = oMessage1.Move(Drafts)
                                    Debug.Print .Item(iCtr).DisplayName
                                End If
                            Next iCtr
                        End If
                    End With
                End If
            End With
            DoEvents
        Next oMessage
        
        Set oAttachment = Nothing
        Set oAttachments = Nothing
        Set oMessage = Nothing
        Set oFldr = Nothing
        Set oNs = Nothing
        Set oOutlook = Nothing
End Sub

Here attachment is saved to disk and then email created from it which is moved to draft folder ... u can move it to another folder too and remove file
 
Back
Top