outlook vba

DonkeyOte

DonkeyOte

MrExcel MVP
Joined
Sep 6, 2002
Messages
9,124
:rolleyes:

Guys, my boss has asked me to write some code that will loop through a specific outlook folder and strip any attachments it finds within an individual message....

the below code does the trick in theory BUT it although the attachment count drops to 0 the mail item itself doesn't change - ie there are still attachments in the message. I am obviously missing something quite important - ie do I need to open the message item strip it then save it and close it to effect the change?

Would be grateful if someone could let me know asap or alternatively point me somewhere.... :unsure:

Merci.

Sub a()

Dim item As MailItem

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolders = myNameSpace.Folders
Set myfolder = myfolders.item(3)
Set myfolder2 = myfolder.Folders("test")
For Each item In myfolder2.Items
x = item.Subject
y = item.SenderName
Set myattachments = item.Attachments
z = myattachments.Count
Do Until z = 0
myattachments.Remove 1
z = myattachments.Count
Loop
item.Save
Next item

End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
Some nice code from Ivan F Moala:

<font face=Courier New>Sub GetDetails_SaveAttachments()

<SPAN style="color:darkblue">Dim</SPAN> OutApp <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>    <SPAN style="color:green">'Outlook.Application</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> NmSpace <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>   <SPAN style="color:green">'Outlook.NameSpace</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> Inbox <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>     <SPAN style="color:green">'Outlook.MAPIFolder</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> MItem <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>     <SPAN style="color:green">'Outlook.MailItem</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> i <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Long</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> Attach <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> x <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Integer</SPAN>

<SPAN style="color:green">'// Amend to your save Dir</SPAN>
<SPAN style="color:darkblue">Const</SPAN> strFilePathAttachment <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN> = "C:\MyFolder\"

<SPAN style="color:darkblue">Set</SPAN> OutApp = CreateObject("Outlook.Application")
<SPAN style="color:darkblue">Set</SPAN> NmSpace = OutApp.GetNamespace("MAPI")
<SPAN style="color:darkblue">Set</SPAN> Inbox = NmSpace.GetDefaultFolder(6)
i = 2

<SPAN style="color:green">'// In case of UNDELIVERABLES</SPAN>
<SPAN style="color:darkblue">On</SPAN> <SPAN style="color:darkblue">Error</SPAN> <SPAN style="color:darkblue">Resume</SPAN> <SPAN style="color:darkblue">Next</SPAN>
<SPAN style="color:darkblue">For</SPAN> <SPAN style="color:darkblue">Each</SPAN> MItem <SPAN style="color:darkblue">In</SPAN> Inbox.Items
    DoEvents
    <SPAN style="color:green">'// Note Only looking for Items within THIS MONTH!</SPAN>
    <SPAN style="color:darkblue">If</SPAN> Month(MItem.ReceivedTime) = Month(Now) <SPAN style="color:darkblue">Then</SPAN>
        
<SPAN style="color:darkblue">If</SPAN> Err <SPAN style="color:darkblue">Then</SPAN> Err.Clear:
<SPAN style="color:darkblue">GoTo</SPAN> N
        i = i + 1
        Cells(i, 1) = MItem.Subject
        Cells(i, 2) = MItem.SenderName
        Cells(i, 3) = MItem.ReceivedTime
        <SPAN style="color:darkblue">Set</SPAN> Attach = MItem.Attachments
        Cells(i, 4) = Attach.Count
        <SPAN style="color:darkblue">If</SPAN> Attach.Count <> 0 <SPAN style="color:darkblue">Then</SPAN>
            <SPAN style="color:darkblue">For</SPAN> x = 1 <SPAN style="color:darkblue">To</SPAN> Attach.Count
                Cells(i, 4 + x) = MItem.Attachments.Item(x)
                <SPAN style="color:darkblue">With</SPAN> Attach
                      .Item(x).SaveAsFile strFilePathAttachment _
                                 & .Item(x).Filename
                <SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">With</SPAN>
            <SPAN style="color:darkblue">Next</SPAN> x
        <SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">If</SPAN>
    <SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">If</SPAN>
N: <SPAN style="color:darkblue">Next</SPAN> MItem

<SPAN style="color:darkblue">Set</SPAN> MItem = <SPAN style="color:darkblue">Nothing</SPAN>
<SPAN style="color:darkblue">Set</SPAN> Inbox = <SPAN style="color:darkblue">Nothing</SPAN>
<SPAN style="color:darkblue">Set</SPAN> NmSpace = <SPAN style="color:darkblue">Nothing</SPAN>
<SPAN style="color:darkblue">Set</SPAN> OutApp = <SPAN style="color:darkblue">Nothing</SPAN>
<SPAN style="color:darkblue">Set</SPAN> Attach = <SPAN style="color:darkblue">Nothing</SPAN>

<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN></FONT>
 
Upvote 0
Thanks Juan but I think I was a little too vague - the code Ivan provided is good stuff but I should point out that I am running my code in Outlook (I know this is Mr EXCEL but most of you (MVPs) and proteges are pretty handy with cross application stuff and vb in general so I was kinda hoping that someone would be able to help me in Outlook.

Basically - it seems the code you provided will return the attachment string etc from a message to a cell. What I need to do is strip the attachment from the message in Outlook. The code I offered supposedly removes the attachments from the message...and if you step through it, it does just that...ie the mail item results in 0 attachments. However, if you then go to Outlook itself and view the message the attachments are still there. So I figure I need to do something else ... if I was in Outlook itself I would have to open the message to delete the attachment and then close the message saving the changes. My code does not appear to open the item, which I guess is what I am trying to find out how to do....

Phew.

:unsure:

Thanks though....
 
Upvote 0
Hi

Do You want to total remove and delete the attachments?


Master Juan (y) - Ivan cool stuff was first published at Ozgrid :wink:

Kind regards,
Dennis
 
Upvote 0
XL-Dennis said:
...Master Juan (y) - Ivan cool stuff was first published at Ozgrid :wink:

Kind regards,
Dennis
Click to expand...

Well, actually it was first published here (Not entirely, but the majority), then in Ozgrid... but I did say that it's Ivan's code... :p


and laws, there's another method for the Outlook.Attach object, which is .Delete, so with Ivan's code you should be able to do:

.Item(x).Delete
 
Upvote 0
Yeah thanks....

Code: 
Dim item As MailItem

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolders = myNameSpace.Folders
Set myfolder = myfolders.item(3)
Set myfolder2 = myfolder.Folders("test")
For Each item In myfolder2.Items
x = item.Subject
y = item.SenderName
Set myAttachments = item.Attachments
While myAttachments.Count > 0
myAttachments.item(1).Delete
Wend
item.Save
Next item

My original syntax using Remove wasn't working, replacing with Delete works fine.

You never know, this mat come in handy for someone else.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Parse HTML table or extract Outlook body items to excel sheet
Replies
2
Views
254
Jaffirahamed
J
C
  • Question
One or more Modules for each sub
Replies
0
Views
706
CrashOD
C
R
  • Question
Capture the Email Respose Time in Outlook
Replies
1
Views
3K
12anonymouse
1
Z
  • Question
Loop this code trough all folders in Outlook
Replies
1
Views
4K
RayFrye
RayFrye
R
  • Question
Run Outlook rule
2
Replies
11
Views
711
welshgasman
welshgasman

Forum statistics

Threads
1,215,992
Messages
6,128,165
Members
449,428
Latest member
d4vew

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top