Create Email Draft With All Attachments From Directory (1 Viewer)

IgnoranceIsBliss

Registered User.
Local time
Today, 14:40
Joined
Jun 13, 2019
Messages
35
Hi - I am attempting to create an email draft with all files from a directory as attachments. I attempted to utlize this handy script I found online, but I am getting an error of:
Run-time error '9':

Subscript out of range
on this line
Code:
For i = LBound(allFiles) To UBound(allFiles)

And this is my syntax. Can someone more adept with VBA help me get this script wroking?

Further....the folder location is stored in a local access table, and the only variable is the year could be 2019 or 2018...I was trying to use Year(Date) so that it could be used moving forward and not hardcode dates...I.E. once 2020 hits, it will first look for 2020 and if not found look for 2019

Code:
Private Sub btnCreateEmail_Click()
Dim allFiles() As String

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

With MailOutLook
	.BodyFormat = olFormatHTML
	.To = "internal@test.com"
	
	.Subject = "Test Email"
	.Body = "Test Email Body"
	
	If FolderExists(Me.combo0.Column(1) & "\" & Year(Date) & "\") False Then
		allFiles = FF_ListFilesInDir(Me.combo0.Column(1) & "\" & Year(Date) - 1 & "\")
		For i = LBound(allFiles) To UBound(allFiles)
			.Attachments.Add(i)
		Next i
	Else
		allFiles = FF_ListFilesInDir(Me.combo0.Column(1) & "\" & Year(Date) & "\")
		For i = LBound(allFiles) To UBound(allFiles)
			.Attachments.Add(i)
		Next i
	End If
	.Save
End With
End Sub	.

'---------------------------------------------------------------------------------------
' Procedure : FF_ListFilesInDir
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : cardaconsultants.com
' Purpose   : Return a list of files in a given directory
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - /creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sPath     : Full path of folder to examine with trailing \
' sFilter   : specific file extension to limmit search to, leave blank to list all files
'
' Usage:
' ~~~~~~
' FF_ListFilesInDir("C:\Users\Daniel\Documents\") 'List all the files
' FF_ListFilesInDir("C:\Users\Daniel\Documents\","xls") 'Only list Excel files
' FF_ListFilesInDir("C:\Users\Daniel\Documents\","doc") 'Only list Word files
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-Jul-13             Initial Release
' 2         2019-02-03              Updated copyright & function header
'                                   Changed function name to follow naming convention
'                                   Added \ check in sPath string
'                                   Changed the function to return an array of the files
'---------------------------------------------------------------------------------------
Function FF_ListFilesInDir(sPath As String, Optional sFilter As String = "*") As Variant
    Dim aFiles()              As String
    Dim sFile                 As String
    Dim i                     As Long
 
    On Error GoTo Error_Handler
 
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    sFile = Dir(sPath & "*." & sFilter)
    Do While sFile <> vbNullString
        If sFile <> "." And sFile <> ".." Then
            ReDim Preserve aFiles(i)
            aFiles(i) = sFile
            i = i + 1
        End If
        sFile = Dir     'Loop through the next file that was found
    Loop
    FF_ListFilesInDir = aFiles
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: FF_ListFilesInDir" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

if I need to notate that the Function FF_ListFilesInDir was pulled straight from another site, please let me know and I'm happy to. I left the comments at the top of the Function which point back to the source, but if more should be done I will gladly edit. (Okay, I had to remove the http and www from it since I am new I can't post links yet.)
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 14:40
Joined
Aug 30, 2003
Messages
36,118
Is i declared elsewhere? If not it should be, plus see the link below. Were files found to attach? Hit Debug after you get the error and hover over the LBound and UBound items and see what they're returning.

http://www.baldyweb.com/OptionExplicit.htm

By the way, posting the code with attribution as you did is fine.
 

IgnoranceIsBliss

Registered User.
Local time
Today, 14:40
Joined
Jun 13, 2019
Messages
35
Is i declared elsewhere? If not it should be, plus see the link below. Were files found to attach? Hit Debug after you get the error and hover over the LBound and UBound items and see what they're returning.

By the way, posting the code with attribution as you did is fine.

Hah! That was one issue...I did a
Code:
Debug.Print Me.combo0.Column(1) & "\" & Year(Date) & "\"

And saw that I was printing a directory with an extra \ in it.

NOW...I am getting the error of
Run-time error '5':
Invalid procedure call or argument

on this line
Code:
.Attachments.Add (i)

oh and yes, I have i declared like so
Code:
Dim i As Integer

And if I copy/paste the address that Debug.Print produces there are files in the folder. There could be a sub-folder also. Could that be what is throwing the issue, that the VBA code doesn't know how to handle a "folder" only "files"?
 

June7

AWF VIP
Local time
Today, 13:40
Joined
Mar 9, 2014
Messages
5,423
Try:

.Attachments.Add (allFiles(i))
 

IgnoranceIsBliss

Registered User.
Local time
Today, 14:40
Joined
Jun 13, 2019
Messages
35
Try:

.Attachments.Add (allFiles(i))

That put me one step closer!!!

As you suggested
Code:
.Attachments.Add(allFiles(i))

Would add the file name, but the code needed full path, so I changed it to

Code:
.Attachments.Add(Me.combo0.Column(1) & "\" & Year(Date) & "\" & allFiles(i))

And it works exactly as desired.

Thanks so much!
 

Users who are viewing this thread

Top Bottom