Untitled

mail@pastecode.io avatar
unknown
plain_text
a month ago
2.9 kB
1
Indexable
Never
   ' 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
Leave a Comment