IgnoranceIsBliss
Registered User.
- Local time
- Today, 07:04
- 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
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
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.)
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.)