Mo-ra
Member
- OS Version(s)
- Windows
- Outlook version
- Outlook 365 64 bit
- Email Account
- Office 365 Exchange
Operating system:: Windows 11
Outlook version: 365
Email type or host: Microsoft 365
Outlook version: 365
Email type or host: Microsoft 365
I found this code online for file picker and attach pdfs to an email. However, is it possible to amend the code so when the macro is run, it attaches the PDF file(s) to the already open compose new mail window (and not a brand new compose mail window).
Code:
Sub AttachPDFs()
Dim olItem As Outlook.MailItem
Dim olAttachments As Outlook.Attachments
Dim strPath As String
Dim strFile As String
Dim i As Long
Dim oFrm As New UserForm1
With oFrm
.Caption = "Select files to attach"
.Height = 272
.Width = 240
.CommandButton1.Caption = "Continue"
.CommandButton1.Top = 210
.CommandButton1.Width = 72
.CommandButton1.Left = 132
.CommandButton2.Caption = "Cancel"
.CommandButton2.Top = 210
.CommandButton2.Width = 72
.CommandButton2.Left = 18
.ListBox1.Top = 12
.ListBox1.Left = 18
.ListBox1.Height = 192
.ListBox1.Width = 189
.ListBox1.MultiSelect = fmMultiSelectMulti
'If the files are always in the same folder you could set strPath to that folder e.g.
strPath = "C:\Mydirectory\"
strFile = Dir$(strPath & "*.pdf")
While Not strFile = ""
On Error GoTo err_Handler
.ListBox1.AddItem strFile
strFile = Dir$()
Wend
.Show
If .Tag = 1 Then
Set olItem = Application.CreateItem(olMailItem)
Set olAttachments = olItem.Attachments
For i = 0 To .ListBox1.ListCount - 1
If .ListBox1.Selected(i) Then
olAttachments.Add strPath & .ListBox1.List(i), _
olByValue, 1
End If
Next i
olItem.Display
End If
End With
Unload oFrm
lbl_Exit:
Set olItem = Nothing
Set olAttachments = Nothing
Set oFrm = Nothing
Exit Sub
err_Handler:
MsgBox Err.Number & vbCr & Err.Description
Err.Clear
GoTo lbl_Exit
End Sub