vba outlook

dulitul

Board Regular
Joined
Jan 19, 2013
Messages
193
Hey folks,


I ve got this code. It saves all pdf attachments from outlook folder and renames them in consequential order. However, what I want is that code renames them in the reverse sequence. Currently, it puts on the first item in inbox (sorted by date) the last number in folder and so on. I want the reverse sequence. The first one in the outlook inbox should get the first number in the sequence and so on..

Private Sub cmdConnectToOutlook_Click()
Dim appOutlook As Outlook.Application
Dim ns As Outlook.NameSpace
Dim inbox As Outlook.MAPIFolder
Dim item As Object
Dim atmt As Outlook.Attachment
Dim filename As String
Dim i As Integer




Set appOutlook = GetObject(, "Outlook.Application")
Set ns = appOutlook.GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderDrafts)
i = 0
m = 1




If inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If




For Each item In inbox.Items
For Each atmt In item.Attachments


If Right(atmt.filename, 3) = "pdf" Then
filename = atmt.filename
atmt.SaveAsFile "C:\Intel\Logs\" & m & ".pdf"
i = i + 1
m = m + 1
End If


Next atmt
Next item


MsgBox "Attachments have been saved.", vbInformation, "Finished"


Set atmt = Nothing
Set item = Nothing
Set ns = Nothing


End Sub
 
Last edited:

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

s.ridd

Board Regular
Joined
Nov 23, 2012
Messages
178
Hi there, if I understand what you've asked correctly then the below amendments should solve your problem. I've changed the folder to the Inbox rather than Drafts as well - obviously change that back if required. I commented out some things which are no longer being used. When I copied the code from the forum it messed up all the line spaces and indents so I've had a stab at putting some back in.

Code:
Private Sub cmdConnectToOutlook_Click()

Dim appOutlook As Outlook.Application
Dim ns As Outlook.Namespace
Dim inbox As Outlook.MAPIFolder
'Dim item As Object 'would be Outlook.MailItem
Dim atmt As Outlook.Attachment
'Dim filename As String
Dim i As Integer ',m as Integer


Set appOutlook = GetObject(, "Outlook.Application")
Set ns = appOutlook.GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)
m = 1


If inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
    "Nothing Found"
    Exit Sub
End If


For i = inbox.Items.Count To 1 Step -1
    For Each atmt In inbox.Items(i).Attachments
        If Right(atmt.filename, 3) = "pdf" Then
            'filename = atmt.filename
            atmt.SaveAsFile "C:\Intel\Logs\" & m & ".pdf"
            m = m + 1
        End If
    Next atmt
Next i


MsgBox "Attachments have been saved.", vbInformation, "Finished"


Set atmt = Nothing
Set item = Nothing
Set ns = Nothing
Set appOutlook = Nothing


End Sub

Hope this helps, any issues let me know

Simon
 

dulitul

Board Regular
Joined
Jan 19, 2013
Messages
193
Sub moveOfficeGossip()
Dim Item As Outlook.MailItem
Dim strNames As MailItem
Dim ton As Folder
Dim olApp As New Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olDestFolder As Outlook.MAPIFolder
Dim objNS As NameSpace
Set objNS = Application.Session
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set ton = objNS.GetDefaultFolder(olFolderDrafts)


Set olNameSpace = olApp.GetNamespace("MAPI")


For Each strNames In olInboxItems
If strNames.To = "hoho@gmail.com" Then
strNames.Move ton
End If
Next
End Sub
 

s.ridd

Board Regular
Joined
Nov 23, 2012
Messages
178
Your code is a little confusing, and I can't tell whether you're trying to run this from Excel or Outlook. Using your first piece of code as a guide, I'm guessing Excel, perhaps the code below will achieve what you're looking for.

Code:
Sub moveOfficeGossip()

Dim outApp As Outlook.Application
Dim outNS As Outlook.Namespace
Dim outItems As Outlook.Items
Dim outItem As Object
Set outApp = Outlook.Application
Set outNS = outApp.Session
Set outItems = outNS.GetDefaultFolder(olFolderInbox).Items
    
    For Each outItem In outItems
        If outItem.Subject = "Cakes" Then outItem.Move outNS.GetDefaultFolder(olFolderDrafts)
    Next outItem

Set outItem = Nothing
Set outItems = Nothing
Set outNS = Nothing
Set outApp = Nothing
    
End Sub

OutItem is called as an Object as there may be other types of items (eg. Appointment) in your inbox.

Simon
 

Watch MrExcel Video

Forum statistics

Threads
1,122,518
Messages
5,596,622
Members
414,082
Latest member
sasmita

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
Top