Save Attachment Using Macro

[simon.stewart]

Hi, I have a seperate folder in outlook that receives 3 emails a day,
one of which has a .csv attachment with it. I have a macro that looks
in my folder, saves the file to my P drive and then places the email in
another folder. It all works fine apart from the fact that the file
name changes everyday (the last 4 digits are the day and month it gets
sent), so I have to change the macro everyday to the most recent that
days date. How do I have it so it will save ANY file in the folder of
choice, as that would do. Here is my code... (the problem line of code
is If olAtt.Filename = "Fidel1_20060804.csv" Then)

Sub SaveAttachments()

Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim MoveToFldr As MAPIFolder
Dim olMi As MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim i As Long

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = GetFolder("Mailbox - Stewart, Simon\Inbox\Alex")
Set MoveToFldr = GetFolder("Mailbox - Stewart,
Simon\Inbox\Alex\AlexArchive")
MyPath = "P:\!Performance\"

For i = Fldr.Items.Count To 1 Step -1
Set olMi = Fldr.Items(i)
If olMi.Attachments.Count > 0 Then
For Each olAtt In olMi.Attachments
If olAtt.Filename = "Fidel1_20060804.csv" Then
olAtt.SaveAsFile MyPath & olMi.SenderName & ".csv"
End If
Next olAtt
olMi.Save
olMi.Move MoveToFldr
End If
Next i



Set olAtt = Nothing
Set olMi = Nothing
Set Fldr = Nothing
Set MoveToFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

Public Function GetFolder(strFolderPath As String) As MAPIFolder
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim i As Long
On Error Resume Next

strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If

Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function

 

[Ken Slovak - [MVP - Outlook]]

If the last 8 characters are always in that pattern use functions to extract
the current year, month and day and put together your search string:

sYear = CStr(Year(Date))
sMonth = CStr(Month(Date))
sDay = CStr(Day(Date))

Check the resulting strings for proper leading zeros or use Format to format
the strings with leading zeros as neeed and put together your search string
that way.

 

[Michael Bednarek]

Hi, I have a seperate folder in outlook that receives 3 emails a day,
one of which has a .csv attachment with it. I have a macro that looks
in my folder, saves the file to my P drive and then places the email in
another folder. It all works fine apart from the fact that the file
name changes everyday (the last 4 digits are the day and month it gets
sent), so I have to change the macro everyday to the most recent that
days date. How do I have it so it will save ANY file in the folder of
choice, as that would do. Here is my code... (the problem line of code
is If olAtt.Filename = "Fidel1_20060804.csv" Then)

[snip]

For today:
Dim strDate as String
strDate = Format(Now(), "YYYYMMDD")
If olAtt.Filename = "Fidel1_" & strDate & ".csv" Then
olAtt.SaveAsFile MyPath & olMi.SenderName & ".csv"

For yesterday: Now()-1, for previous working day: PrevWDay(Now())
where PrevWDay:

Function PrevWDay(datDate As Date) As Date
Dim lngWD As Integer
lngWD = Weekday(datDate, vbMonday)
PrevWDay = datDate - IIf(lngWD = 1, 3, IIf(lngWD = 7, 2, 1))
End Function

or slightly shorter, but more obscure:

lngWD = Weekday(datDate, vbTuesday) - 4
PrevWDay = datDate - IIf(lngWD > 0, lngWD, 1)

 

[simon.stewart]

Guys, what can I say?! Genius. Works a treat, I used the previous
working day formula. Now I have one more small problem but will post it
in a new subject. Thanks a lot!

Hi, I have a seperate folder in outlook that receives 3 emails a day,
one of which has a .csv attachment with it. I have a macro that looks
in my folder, saves the file to my P drive and then places the email in
another folder. It all works fine apart from the fact that the file
name changes everyday (the last 4 digits are the day and month it gets
sent), so I have to change the macro everyday to the most recent that
days date. How do I have it so it will save ANY file in the folder of
choice, as that would do. Here is my code... (the problem line of code
is If olAtt.Filename = "Fidel1_20060804.csv" Then)

[snip]

For today:
Dim strDate as String
strDate = Format(Now(), "YYYYMMDD")
If olAtt.Filename = "Fidel1_" & strDate & ".csv" Then
olAtt.SaveAsFile MyPath & olMi.SenderName & ".csv"

For yesterday: Now()-1, for previous working day: PrevWDay(Now())
where PrevWDay:

Function PrevWDay(datDate As Date) As Date
Dim lngWD As Integer
lngWD = Weekday(datDate, vbMonday)
PrevWDay = datDate - IIf(lngWD = 1, 3, IIf(lngWD = 7, 2, 1))
End Function

or slightly shorter, but more obscure:

lngWD = Weekday(datDate, vbTuesday) - 4
PrevWDay = datDate - IIf(lngWD > 0, lngWD, 1)