Untitled
unknown
plain_text
a year ago
2.9 kB
3
Indexable
' Fifth Macro. Download new Samskip rail report. Sub Download_New_Samskip_Rail_Report() Dim objItem As Outlook.mailItem Dim olAttachment As Outlook.attachment Dim savePath As String ' Set the save path for the new.xlsx file savePath = "Z:\Rail_report\new.xlsx" ' Get the currently selected email Set objItem = Application.ActiveExplorer.Selection(1) ' Check if the email has attachments If objItem.Attachments.count > 0 Then ' Loop through attachments to find the one with "*.xlsx" extension For Each olAttachment In objItem.Attachments If olAttachment.DisplayName Like "*.xlsx" Then ' Save the attachment to the specified path using SaveAsFile method olAttachment.SaveAsFile savePath ' Inform the user MsgBox "Attachment saved successfully to: " & savePath Exit For End If Next olAttachment Else ' No attachments found MsgBox "No attachments found in the selected email." End If End Sub ' Sixth Macro. Download old Samskip rail report and launch the query. Sub Download_Old_Samskip_Rail_Report_and_launch_query() Dim objItem As Object Dim olAttachment As Outlook.attachment Dim savePath As String Dim queryFilePath As String Dim excelApp As Object Dim excelWorkbook As Object ' Set the save path for the old.xlsx file "Z:\Rail_report\old.xlsx" ' Set the path for the query.xlsx file queryFilePath = "Z:\Rail_report\query.xlsx" ' Get the currently selected email Set objItem = Application.ActiveExplorer.Selection(1) ' Check if the email has attachments If objItem.Attachments.count > 0 Then ' Loop through attachments to find the one with "*.xlsx" extension For Each olAttachment In objItem.Attachments If olAttachment.DisplayName Like "*.xlsx" Then ' Save the attachment to the specified path using SaveAsFile method olAttachment.SaveAsFile savePath ' Inform the user MsgBox "Attachment saved successfully to: " & savePath ' Open the query.xlsx file Set excelApp = CreateObject("Excel.Application") Set excelWorkbook = excelApp.Workbooks.Open(queryFilePath) ' Refresh Power Query data in the query.xlsx file On Error Resume Next excelWorkbook.RefreshAll On Error GoTo 0 ' Make Excel visible excelApp.Visible = True ' Exit the loop once the attachment is found and processed Exit For End If Next olAttachment Else ' No attachments found MsgBox "No attachments found in the selected email." End If End Sub
Editor is loading...
Leave a Comment