![]() |
#11
|
|||
|
|||
![]()
Hi GMayor:
I mapped the network drive to a local drive letter and added it to the code. Still doesn't work. Thank you for all you help. We will have to just do it manually. Here is what my code looks like now: HTML Code:
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 = "X:\_sponsor_folder" 'If the files are always in the same folder you coiuld set strPath to that folder e.g. strPath = "X:\_sponsor_folder" 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 |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Shortcut for downloading attachments in e-mail | paik1002 | Outlook | 4 | 12-11-2015 03:01 AM |
![]() |
rambler289 | Outlook | 1 | 09-29-2015 09:33 PM |
Adding attachments to (e)mail-mege message | Roger Keeling | Mail Merge | 2 | 05-23-2015 06:04 AM |
Mail merge with personalized attachments | sharke | Outlook | 0 | 07-01-2011 07:16 AM |
![]() |
wineattorney | Outlook | 1 | 03-29-2011 02:15 AM |