![]() |
| 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. |
|
|||||||
| Tags: attachment, macro, save, using |
|
|
Thread Tools | Display Modes |
|
#1
|
|||
|
|||
|
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
|
|||
|
|||
|
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
|
|||
|
|||
|
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
|
|||
|
|||
|
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 | |
|
|
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 |