malleshg24
02-03-2018, 06:27 AM
:helpHi Team,
I am learning vba outlook and creating macro for a Team,
We receive DailyReport file in our Inbox, So my task is to move that file to D Drive.
My below code works, but it works only in my PC, In my colleague it won't work because they have diverted
Reportfile to subfolders by creating system rule.
So I want user to get folder picker option and selected outlook folder name should get pasted in range("d5")
and that outlookfolder should linked to onamespace.GetDefaultFolder(olFolderInbox)
Plz assist. Thanks in Advance !
Sub attachment_save()
Dim olook As Outlook.Application
Dim omailitem As Outlook.mailitem
Dim onamespace As Outlook.Namespace
Dim fol As Outlook.Folder
Dim atmt As Outlook.Attachment
Set olook = New Outlook.Application
Set omailitem = Outlook.CreateItem(olMailItem)
Set onamespace = olook.GetNamespace("MAPI")
Set fol = onamespace.GetDefaultFolder(olFolderInbox)
Dim z As String
For Each omail In fol.Items
z = omail.Subject
If z Like "Daily Report*" Then
For Each atmt In omailitem.Attachments
atmt.SaveAsFile "d:/" & atmt.Filename
Next
End If
Next
End Sub
Thanks
Mallesh
I am learning vba outlook and creating macro for a Team,
We receive DailyReport file in our Inbox, So my task is to move that file to D Drive.
My below code works, but it works only in my PC, In my colleague it won't work because they have diverted
Reportfile to subfolders by creating system rule.
So I want user to get folder picker option and selected outlook folder name should get pasted in range("d5")
and that outlookfolder should linked to onamespace.GetDefaultFolder(olFolderInbox)
Plz assist. Thanks in Advance !
Sub attachment_save()
Dim olook As Outlook.Application
Dim omailitem As Outlook.mailitem
Dim onamespace As Outlook.Namespace
Dim fol As Outlook.Folder
Dim atmt As Outlook.Attachment
Set olook = New Outlook.Application
Set omailitem = Outlook.CreateItem(olMailItem)
Set onamespace = olook.GetNamespace("MAPI")
Set fol = onamespace.GetDefaultFolder(olFolderInbox)
Dim z As String
For Each omail In fol.Items
z = omail.Subject
If z Like "Daily Report*" Then
For Each atmt In omailitem.Attachments
atmt.SaveAsFile "d:/" & atmt.Filename
Next
End If
Next
End Sub
Thanks
Mallesh