A Microsoft Outlook email forum. Outlook Banter

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » Outlook Banter forum » Microsoft Outlook Email Newsgroups » Outlook and VBA
Site Map Home Register Authors List Search Today's Posts Mark Forums Read Web Partners

Tags: , , ,

Save Attachment Using Macro





 
 
Thread Tools Display Modes
  #1  
Old August 8th 06, 12:51 PM posted to microsoft.public.outlook.program_vba
simon.stewart@uk.fid-intl.com
external usenet poster
 
Posts: 2
Default Save Attachment Using Macro

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

Ads
  #2  
Old August 8th 06, 03:02 PM posted to microsoft.public.outlook.program_vba
Ken Slovak - [MVP - Outlook]
external usenet poster
 
Posts: 3,778
Default Save Attachment Using Macro

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.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


wrote in message
oups.com...
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


  #3  
Old August 8th 06, 03:37 PM posted to microsoft.public.outlook.program_vba
Michael Bednarek
external usenet poster
 
Posts: 28
Default Save Attachment Using Macro

On 8 Aug 2006 03:51:55 -0700, simon.stewart@... wrote in
microsoft.public.outlook.program_vba:

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 obscu

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


--
Michael Bednarek http://mbednarek.com/ "POST NO BILLS"
  #4  
Old August 8th 06, 04:42 PM posted to microsoft.public.outlook.program_vba
simon.stewart@uk.fid-intl.com
external usenet poster
 
Posts: 2
Default Save Attachment Using Macro

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!

Michael Bednarek wrote:
On 8 Aug 2006 03:51:55 -0700, simon.stewart@... wrote in
microsoft.public.outlook.program_vba:

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 obscu

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


--
Michael Bednarek http://mbednarek.com/ "POST NO BILLS"


 




Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Save attachment with filter by subject goss9394@yahoo.com Outlook and VBA 0 August 3rd 06 04:25 AM
Save Attachment Default Location Ken Outlook Express 4 July 27th 06 11:11 PM
Save Meeting Request w/Attachment WordHazIt Outlook - Calandaring 2 July 21st 06 04:26 PM
OE6 don't save modifcation on attachment Sorin TENE Outlook Express 7 April 6th 06 10:27 AM
Macro to add an attachment Bear Outlook - Using Forms 1 February 3rd 06 05:57 AM


All times are GMT +1. The time now is 03:12 AM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2008, Jelsoft Enterprises Ltd.Search Engine Friendly URLs by vBSEO 2.4.0
Copyright ©2004-2008 Outlook Banter, part of the NewsgroupBanter project.
The comments are property of their posters.
Remortgages - Loans - Proxy - Online Loans - PC Headsets