Anantha Krishna
Member
Hi Everyone,
Can anybody help me for the below requirement?
I need to save the file from outlook to my system based on subject and date, and also file should rename as per subject.
below is the code which i find, but it is saving the based on subject from all mails, i need only to save particular date which i mention.
Public Sub Extract_Outlook_Email_Attachments()
Dim OutlookOpened As Boolean
Dim outApp As Outlook.Application
Dim outNs As Outlook.Namespace
Dim outFolder As Outlook.MAPIFolder
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "mm/dd/yyyy")
saveFolder = "C:\New Folder (2)\Daily Report"
Dim outMailItem As Outlook.MailItem
Dim inputDate As String, subjectFilter As String
inputDate = InputBox("Enter date to filter the email subject", "Extract Outlook email attachments")
If inputDate = "" Then Exit Sub
If Right(saveFolder, 1) <> "\" Then saveFolder = saveFolder & "\"
InputDateFilter = inputDate
subjectFilter = ("Project Daily Report")
'Get or create Outlook object and make sure it exists before continuing
OutlookOpened = False
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set outApp = New Outlook.Application
OutlookOpened = True
End If
On Error GoTo 0
If outApp Is Nothing Then
MsgBox "Cannot start Outlook.", vbExclamation
Exit Sub
End If
Set outNs = outApp.GetNamespace("MAPI")
Set outFolder = outNs.Folders("My Outlook Data File(1)")
Set outFolder = outNs.Folders("My Outlook Data File(1)").Folders("Daily Report") 'CHANGE FOLDER AS NEEDED
'Set outFolder = outNs.PickFolder 'OR USER SELECTS FOLDER
If Not outFolder Is Nothing Then
For Each outItem In outFolder.Items
If outItem.Class = Outlook.OlObjectClass.olMail Then
Set outMailItem = outItem
If outMailItem.Subject = subjectFilter Then
Debug.Print outMailItem.Subject
For Each outAttachment In outMailItem.Attachments
outAttachment.SaveAsFile saveFolder & outAttachment.Filename & strValues
Set outAttachment = Nothing
Next
End If
End If
Next
End If
If OutlookOpened Then outApp.Quit
Set outApp = Nothing
End Sub
Can anybody help me for the below requirement?
I need to save the file from outlook to my system based on subject and date, and also file should rename as per subject.
below is the code which i find, but it is saving the based on subject from all mails, i need only to save particular date which i mention.
Public Sub Extract_Outlook_Email_Attachments()
Dim OutlookOpened As Boolean
Dim outApp As Outlook.Application
Dim outNs As Outlook.Namespace
Dim outFolder As Outlook.MAPIFolder
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "mm/dd/yyyy")
saveFolder = "C:\New Folder (2)\Daily Report"
Dim outMailItem As Outlook.MailItem
Dim inputDate As String, subjectFilter As String
inputDate = InputBox("Enter date to filter the email subject", "Extract Outlook email attachments")
If inputDate = "" Then Exit Sub
If Right(saveFolder, 1) <> "\" Then saveFolder = saveFolder & "\"
InputDateFilter = inputDate
subjectFilter = ("Project Daily Report")
'Get or create Outlook object and make sure it exists before continuing
OutlookOpened = False
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set outApp = New Outlook.Application
OutlookOpened = True
End If
On Error GoTo 0
If outApp Is Nothing Then
MsgBox "Cannot start Outlook.", vbExclamation
Exit Sub
End If
Set outNs = outApp.GetNamespace("MAPI")
Set outFolder = outNs.Folders("My Outlook Data File(1)")
Set outFolder = outNs.Folders("My Outlook Data File(1)").Folders("Daily Report") 'CHANGE FOLDER AS NEEDED
'Set outFolder = outNs.PickFolder 'OR USER SELECTS FOLDER
If Not outFolder Is Nothing Then
For Each outItem In outFolder.Items
If outItem.Class = Outlook.OlObjectClass.olMail Then
Set outMailItem = outItem
If outMailItem.Subject = subjectFilter Then
Debug.Print outMailItem.Subject
For Each outAttachment In outMailItem.Attachments
outAttachment.SaveAsFile saveFolder & outAttachment.Filename & strValues
Set outAttachment = Nothing
Next
End If
End If
Next
End If
If OutlookOpened Then outApp.Quit
Set outApp = Nothing
End Sub