Untitled
unknown
plain_text
2 years ago
2.9 kB
6
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 SubEditor is loading...
Leave a Comment