Trying to select filles Pdf from folder then put them into a Email

Eric Penfold

Active Member
Joined
Nov 19, 2021
Messages
250
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
The codes open a Email find but can`t seem to grab any files?

VBA Code:
Private Sub Email_Files_Click()

    Dim objol     As Object
    Dim objmail   As Object
    Dim objFolder As Object
    Dim fso       As Object
    Dim fsFolder  As Object
    Dim fsFile    As Object
    Dim strFolder As String
    Dim strFile   As String
    Dim MyPath    As String
    Dim Pdf       As String
    Dim DXF       As String
    Dim SubPath   As String
    Dim PDFFName  As String
    Dim DXFFName  As String
    Dim CmbData

   

    CmbData = Split(Me.OpenDrawing.Value, "-")
    CmbData(0) = Replace(CmbData(0), "-", "")
    SourcePath = "\\dc01\Company\R&D\Drawing Nos"
    SubPath = CStr(Val(Int(CmbData(0) / 50) * 50 + 1) & "-" & Int(CmbData(0) / 50 + 1) * 50)
    

    strFolder = (SourcePath & "\" & SubPath & "\" & OpenDrawing.Value)
    strFile = Dir(strFolder & "*.pdf")

    Set objol = CreateObject("Outlook.Application")
    Set objmail = objol.CreateItem(0)

With objmail
.to = "darren@drainfast.co.uk"
.cc = ""
.BCC = ""
.Subject = "All Files to Send" & Format(Date, "mm/dd/yyyy")
.Display
.HTMLBody = "Please see Attached files to Process <p>" & _
"And or Please see Attached files to Quote for"

   Do While strFile <> ""
       .Attachments.Add strFolder & strFile
       strFile = Dir
       Loop
        
End With

errhndl:
        Set objFolder = Nothing
        Set fso = Nothing
        Set fsFolder = Nothing
        Set objol = Nothing
        Set objmail = Nothing
        
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
20,802
Office Version
  1. 365
Platform
  1. Windows
strFolder = (SourcePath & "\" & SubPath & "\" & OpenDrawing.Value)

While the above statement assigns a path to strFolder, it should end with a backslash ( \ ) . Does it?
 
Upvote 0

Eric Penfold

Active Member
Joined
Nov 19, 2021
Messages
250
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
VBA Code:
Private Sub Email_Files_Click()

        Dim objol     As Object
        Dim objmail   As Object
        Dim objFolder As Object
        Dim FSOLibary As FileSystemObject, FSOFolder As Object, FSOFile As Object
        Dim FolderName As String
        Dim SourcePath As String
        Dim SubPath As String
        Dim PdfFolder As Folder
        Dim PdfFile As String
        Dim MyPath As String
        Dim PDFFName As String
        Dim CmbData

   
    Set objol = CreateObject("Outlook.Application")
    Set objmail = objol.CreateItem(0)
    
    CmbData = Split(Me.OpenDrawing.Value, "-")
    CmbData(0) = Replace(CmbData(0), "-", "")
    
    SourcePath = "\\dc01\Company\R&D\Drawing Nos"
    SubPath = CStr(Val(Int(CmbData(0) / 50) * 50 + 1) & "-" & Int(CmbData(0) / 50 + 1) * 50)

With objmail
.to = "darren@drainfast.co.uk"
.cc = ""
.BCC = ""
.Subject = "All Files to Send" & Format(Date, "mm/dd/yyyy")
.Display
.HTMLBody = "Please see Attached files to Process <p>" & _
"And or Please see Attached files to Quote for"

        FolderName = (SourcePath & "\" & SubPath & "\" & Int(CmbData(0)))
        Set FSOLibary = New Scripting.FileSystemObject
        Set FSOFolder = FSOLibary.GetFolder(FolderName)
        Set FSOFile = FSOFolder.Files
        
        
        For Each FSOFile In FSOFolder.Files
        If FSOFile.Name Like "*" & ".pdf" Then
        .Attachments.Add FSOFile
        End If
        Next FSOFile
        
End With

errhndl:
        Set objFolder = Nothing
        Set fso = Nothing
        Set fsFolder = Nothing
        Set objol = Nothing
        Set objmail = Nothing
        
End Sub
While the above statement assigns a path to strFolder, it should end with a backslash ( \ ) . Does it?
I have had another go with this and i know that the path, folder and PDF file work but I can`t attach it to a email??
The error is 438
 
Upvote 0

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
20,802
Office Version
  1. 365
Platform
  1. Windows
Try...

VBA Code:
.Attachments.Add FSOFile.Path

Hope this helps!
 
Upvote 0

Eric Penfold

Active Member
Joined
Nov 19, 2021
Messages
250
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
Thanks all working now
 
Upvote 0

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
20,802
Office Version
  1. 365
Platform
  1. Windows
You're very welcome, glad I could help.

By the way, you don't need the following line of code. So you can get rid of it.

Code:
Set FSOFile = FSOFolder.Files

Also, you have the line label errhndl: for an On Error GoTo statement, but your code doesn't have the On Error GoTo statement. So, unless your actual code contains an On Error GoTo statement, you can get rid of it as well.

Cheers!
 
Upvote 0

Forum statistics

Threads
1,186,249
Messages
5,956,830
Members
438,268
Latest member
julianobessa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top