Sub macro1()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim FolderPath As String
Dim FileName As String
FolderPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
Dim DmToday As Date
DmToday = Format(Date, "mmmm dd yyyy")
Dim EmAttach As Outlook.Attachments
Dim AttachCount As Long
Dim EmAttFile As Object
Dim sFileType As String
Dim oOutlook As Object
Dim oNS As Object
Dim oItems As Object
Dim oFilterItems As Object
Dim oFilterItem As Object
Dim sFilter As String
Dim bOutlookOpened As Boolean
Dim i As Long
Const olFolderInbox = 6
Set oOutlook = GetObject(, "Outlook.Application") 'Bind to existing instance of Outlook
Set oNS = oOutlook.GetNamespace("MAPI")
Set oItems = oNS.GetDefaultFolder(olFolderInbox)
'Set oItems = oNS.Folders("my email@email.com" - "Inbox")
' Set oItems = oItems.Folders("Inbox")
sFilter = "@SQL=""urn:schemas:httpmail:subject"" ci_phrasematch 'Daily Prod Report'"
'Concatenate with filter for todays date
sFilter = sFilter & "@SQL=""urn:schemas:httpmail:datereceived"" = DmToday"
'FROM Email Address Filter (exact match)
sFilter = sFilter & """urn:schemas:httpmail:fromemail"" ci_phrasematch 'data-studio-noreply@google.com'"
Set EmAttFile = oItems.Items.Restrict(sFilter)
' Get the file name.
EmAttFile = EmAttach.Item(1).FileName
' Combine with the path to the folder.
EmAttFile = FolderPath & EmAttFile
' Save the attachment as a file.
EmAttach.Item(1).SaveAsFile EmAttFile
End Sub
Before i get to work on importing the pdf into excel which is the easy part of the macro i cant seem to be able to search and find the file i need and am getting errors.
Any help will be appreciated!
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim FolderPath As String
Dim FileName As String
FolderPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
Dim DmToday As Date
DmToday = Format(Date, "mmmm dd yyyy")
Dim EmAttach As Outlook.Attachments
Dim AttachCount As Long
Dim EmAttFile As Object
Dim sFileType As String
Dim oOutlook As Object
Dim oNS As Object
Dim oItems As Object
Dim oFilterItems As Object
Dim oFilterItem As Object
Dim sFilter As String
Dim bOutlookOpened As Boolean
Dim i As Long
Const olFolderInbox = 6
Set oOutlook = GetObject(, "Outlook.Application") 'Bind to existing instance of Outlook
Set oNS = oOutlook.GetNamespace("MAPI")
Set oItems = oNS.GetDefaultFolder(olFolderInbox)
'Set oItems = oNS.Folders("my email@email.com" - "Inbox")
' Set oItems = oItems.Folders("Inbox")
sFilter = "@SQL=""urn:schemas:httpmail:subject"" ci_phrasematch 'Daily Prod Report'"
'Concatenate with filter for todays date
sFilter = sFilter & "@SQL=""urn:schemas:httpmail:datereceived"" = DmToday"
'FROM Email Address Filter (exact match)
sFilter = sFilter & """urn:schemas:httpmail:fromemail"" ci_phrasematch 'data-studio-noreply@google.com'"
Set EmAttFile = oItems.Items.Restrict(sFilter)
' Get the file name.
EmAttFile = EmAttach.Item(1).FileName
' Combine with the path to the folder.
EmAttFile = FolderPath & EmAttFile
' Save the attachment as a file.
EmAttach.Item(1).SaveAsFile EmAttFile
End Sub
Before i get to work on importing the pdf into excel which is the easy part of the macro i cant seem to be able to search and find the file i need and am getting errors.
Any help will be appreciated!