Power Platform Community Forum Thread Details

Hello,

I've got a VBA script that extracts attachments from emails, and want to incorporate this into my flow. Currently it operates within outlook (Alt,F11), here is the script:

Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
 VBA.MkDir xFolderPath
End If
GFilepath = ""
For Each xMailItem In xSelection
 Set xAttachments = xMailItem.Attachments
 xAttCount = xAttachments.Count
 xSaveFiles = ""
 If xAttCount > 0 Then
 For i = xAttCount To 1 Step -1
 GCount = 0
 xFilePath = xFolderPath & xAttachments.Item(i).FileName
 GFilepath = xFilePath
 xFilePath = FileRename(xFilePath)
 If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
 xAttachments.Item(i).SaveAsFile xFilePath
 If xMailItem.BodyFormat <> olFormatHTML Then
 xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
 Else
 xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
 End If
 End If
 Next i
 End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject("Scripting.FileSystemObject")
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
 GCount = GCount + 1
 xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
 FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
 xHtml = xItem.HTMLBody
 xID = "cid:" & xCid
 If InStr(xHtml, xID) > 0 Then
 IsEmbeddedAttachment = True
 End If
End If
End Function

It works by putting the emails into a folder, highlighting the emails and running the script. The output is to Documents folder, which will contain all the attachments (PDFs). I then wish to run the flow on these PDFs.

How can I run this code/adapt it to run within power automate so that if I receive an email with a .msg or .eml attachment it will save the attachments and then run the flow on those attachments?

Thank you for the help!

Categories:

Building flows