I receive emails each day which give me a report of my site's performance for the previous day. The reports are given a generic name and I am not able to change this at source. I run the below script via an Outlook rule for whenever a message with certain criteria is received and the report is saved to a given location with yesterday's date in the file name:
Public Sub Save Reports (itm As Outlook.MailItem)
Dim ObjAtt As Outlook.Attachment
Dim SaveFolder As String
For Each ObjAtt In itm.Attachments
If InStr(ObjAtt.DisplayName, ".csv") Then
FileName = (ObjAtt.FileName)
NewName = "System Performance " & Format(Date - 1, "DD-MM-YYYY") & Right(FileName, 4)
SaveFolder = "C:\Users\Me\Documents\"
ObjAtt.SaveAsFile SaveFolder & NewName
End If
Set ObjAtt = Nothing
Next
End Sub
The problem is that if we have any problems anywhere within the process, I might get an email today which actually relates to last week rather than yesterday. If this happens the above script does not work and it requires me to save it manually.
One way I could work round this is if I can work out a way to extract data from a cell in the attached CSV file I am saving and then use that as the file name. For every file I want to save, cell B1 has the date that I need to use in the file name.
I have look through Stackoverflow and other internet resources to try and find something that will allow me to do this but have been unable to work it out.
Thanks to a comment below I have tried to edit my script so saves the files, then opens the files and takes the data needed and then renames the file but to no avail:
Public Sub Save Reports (itm As Outlook.MailItem)
Dim ObjAtt As Outlook.Attachment
Dim SaveFolder As String
Dim xlApp As Object
Dim sourceWB As Excel.Workbook
Dim sourceSH As Excel.Worksheet
Dim strFile As String
For Each ObjAtt In itm.Attachments
If InStr(ObjAtt.DisplayName, ".csv") Then
FileName = (ObjAtt.FileName)
NewName = "System Performance " & Format(Date - 1, "DD-MM-YYYY") & Right(FileName, 4)
SaveFolder = "C:\Users\Me\Documents\"
ObjAtt.SaveAsFile SaveFolder & NewName
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
End With
strFile = SaveFolder & NewName
Set sourceWB = Workbooks.Open(strFile, , False, , , , , , , True)
Set sourceSH = sourceWB.Worksheets("Sheet2")
sourceWB.Activate
Range("B1").Select
newdate = ActiveCell.Value
Set sourceWB = Nothing
Set sourceSH = Nothing
xlApp.Quit
Set xlApp = Nothing
Name SaveFolder & NewName As SaveFolder & newdate
End If
Set ObjAtt = Nothing
Next
End Sub
The Outlook object model doesn't provide any property or method for that. You need to save the attached file on the disk first and then open it for reading the cells. The SaveAsFile method of the Attachment class saves the attachment to the specified path.
Also you can try to read the binary content of the attached file using the low-level API - Extended MAPI. The property name is PR_ATTACH_DATA_BIN which contains binary attachment data typically accessed through the OLE IStream interface. See Opening an Attachment for more information. Also you may consider using any third-party wrappers around that API (for example, Redemption).
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.