Code to attach pdf files from my network to an e-mail

[Gary B]

Can I use VBA code to choose files on my network and attach multiple pdf's to an e-mail.
tried the following code but it doesn't work:

Option Explicit
Sub AttachPDFs()Dim olItem As Outlook.MailItemDim olAttachments As Outlook.AttachmentsDim strPath As StringDim strFile As StringDim i As LongDim 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 strPath = "fngn.com\us\Projects\CSServer\Sponsor\" 'If the files are always in the same folder you coiuld set strPath to that folder e.g. strPath = "fngn.com\us\Projects\CSServer\" 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 Suberr_Handler: MsgBox Err.Number & vbCr & Err.Description Err.Clear GoTo lbl_ExitEnd Sub
Function BrowseForFolder(Optional OpenAt As Variant) As VariantDim ShellApp As Object Set ShellApp = CreateObject("Shell.Application"). _ BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
On Error Resume Next BrowseForFolder = ShellApp.self.path On Error GoTo 0
Set ShellApp = Nothing Select Case Mid(BrowseForFolder, 2, 1) Case Is = ":" If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid Case Is = "\" If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid Case Else GoTo Invalid End Selectlbl_Exit: Set ShellApp = Nothing Exit FunctionInvalid: BrowseForFolder = False GoTo lbl_ExitEnd Function

[gmayor]

You asked this in the following link - http://www.msofficeforums.com/outlook/30185-macros-add-attachments-outlook-e-mail.html where I have addressed your concerns. The code does work if you have access to the location.

The code as you have it in this thread cannot work as the line breaks are missing - see the original.

Please do not post in multiple forums without cross posting, to avoid duplication of effort, by those of us who provide our time to respond to user queries.

[Gary B]

Can I use VBA code to choose files on my network and attach multiple pdf's to an e-mail.
tried the following code but it doesn't work:

Option Explicit
Sub AttachPDFs()Dim olItem As Outlook.MailItemDim olAttachments As Outlook.AttachmentsDim strPath As StringDim strFile As StringDim i As LongDim 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 strPath = "fngn.com\us\Projects\CSServer\Sponsor\" 'If the files are always in the same folder you coiuld set strPath to that folder e.g. strPath = "fngn.com\us\Projects\CSServer\" 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 Suberr_Handler: MsgBox Err.Number & vbCr & Err.Description Err.Clear GoTo lbl_ExitEnd Sub
Function BrowseForFolder(Optional OpenAt As Variant) As VariantDim ShellApp As Object Set ShellApp = CreateObject("Shell.Application"). _ BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
On Error Resume Next BrowseForFolder = ShellApp.self.path On Error GoTo 0
Set ShellApp = Nothing Select Case Mid(BrowseForFolder, 2, 1) Case Is = ":" If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid Case Is = "\" If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid Case Else GoTo Invalid End Selectlbl_Exit: Set ShellApp = Nothing Exit FunctionInvalid: BrowseForFolder = False GoTo lbl_ExitEnd Function

[Gary B]

Sorry Graham, Still can't get macro to work. There are line breaks in the original code. Not sure why the code above came out this way. Must have been the way I pasted it in. I'll keep trying. Right now when I run it I get an empty box. It's probably because within the folder there are 3 subfolders that carry the pdf's A_C, D_G,H_Z. I wanted to get to the main folder then be able to choose one of the others to attach the pdf's to an e-mail. I thought another forum would give me something different. Didn't realize that you covered both forums.

[gmayor]

There are only a handful of us that provide the bulk of service for the Office forums. We tend to cover most if not all of them.
If you want to try other forums, then fine, but put a cross reference in the message.
If the box is empty, the code is not reading the path correctly. Do you have the backslash at the end of the path?

[Gary B]

Hi Graham, Yes I have a backslash after the path.
When I run it it comes up with a blank screen in the form and an error at
If .Tag = 1 ThenI am wondering if it has to do with the path. The pdf's are located in sub folders 4 of them A_C, D_I,J_S,T_Z. Each of these folders have clients with pdf's in them like Alcatel-AON then another folder for the year _2016_campaign, then a folder called PDFs, which has all the PDF's that need to be attached to an e-mail. It may be to complicated to be able to do what I want to do and also I don't have enough training in programming VBA. Thanks you for all your help!!

[gmayor]

Did you add the code to the userform? There was a separate block of code that goes in the userform.


Option Explicit

Private Sub CommandButton1_Click()
Me.Hide
Me.Tag = 1
End Sub

Private Sub CommandButton2_Click()
Me.Hide
Me.Tag = 0
End Sub


The following macro will test whether the macro can see your folder


Sub Test()
MsgBox FolderExists("X:\_sponsor_folder\")
lbl_Exit:
Exit Sub
End Sub

Private Function FolderExists(fldr) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FolderExists(fldr)) Then
FolderExists = True
Else
FolderExists = False
End If
lbl_Exit:
Set fso = Nothing
Exit Function
End Function

[Gary B]

Hi Graham, I ran the test and it came up True, but when I run the macro it still comes up blank.

[gmayor]

I don't know what more to suggest. I have just copied the original code (below) from the message to Outlook, created a userform with a list box and two command buttons, added the code to the userform and run the macro. I can even select a network location from the prompt and it works.

Option Explicit


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
strPath = BrowseForFolder & Chr(92)
'If the files are always in the same folder you coiuld set strPath to that folder e.g.
'strPath = "C:\Path\"
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

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
lbl_Exit:
Set ShellApp = Nothing
Exit Function
Invalid:
BrowseForFolder = False
GoTo lbl_Exit
End Function

[Gary B]

Hi Graham, I got the code above to work. It goes to my C Drive. Maybe I don't have the X Drive mapped correctly. This will work for the itme being. Thanks so much for all your time and help on this. Gary B.