Sending Emails from Access DB containing attachment with dynamic name - ms-access

Question

I do not know how to get this thing to work beyond this point.
My code below sends an email containing an attachment out of MS Access 2010.
The problem is if it requires a fixed file name, my file name changes as I am using the date at the end of each file. example: green_12_04_2012.csv. I also do not know how to make this not fail if the folder is empty or the directory changes. It would be great for it to just skip to the next sub rather than crashing.
My Code:
Dim strGetFilePath As String
Dim strGetFileName As String
strGetFilePath = "C:\datafiles\myfolder\*.csv"
strGetFileName = Dir(strGetFilePath)
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = "bob#builder.com"
''.cc = ""
''.bcc = ""
.Subject = "text here"
.HTMLBody = "text here"
.Attachments.Add (strGetFileName & "*.csv")
.Send
End With
End Sub
I think I am getting there.

Answer 1

I found a suitable resolution and in addition to the solution posted, I wanted to add this in-case anyone is searching for the solution. I was up until 3am, this is a very popular question but there was not any resolution in regards to looping an attaching all files in a specific folder.
Here is the code:
Public Sub sendEmail()
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim strPath As String
Dim strFilter As String
Dim strFile As String
strPath = "C:\Users\User\Desktop\" 'Edit to your path
strFilter = "*.csv"
strFile = Dir(strPath & strFilter)
If strFile <> "" Then
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = "bob#builder.com"
''.cc = ""
''.bcc = ""
.Subject = "text here"
.HTMLBody = "text here"
.Attachments.Add (strPath & strFile)
.Send
'.Display 'Used during testing without sending (Comment out .Send if using this line)
End With
Else
MsgBox "No file matching " & strPath & strFilter & " found." & vbCrLf & _
"Processing terminated.
Exit Sub 'This line only required if more code past End If
End If
End Sub

Answer 2

heres code i found on one of the forums and cant remember where, but i modified it slightly
this gives you full path of the file, it searches folder and subfolders using wildcard
Function fSearchFileWild(FileName As String, Extenstion As String)
Dim strFileName As String
Dim strDirectory As String
strFileName = "*" & FileName & "*." & Extenstion
strDirectory = "C:\Documents and Settings\"
fSearchFileWild = ListFiles(strDirectory, strFileName, True)
End Function
Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
Dim colDirList As New Collection
Dim varItem As Variant
Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
Dim counter As Integer
counter = 0
Dim file1 As String
Dim file2 As String
Dim file3 As String
For Each varItem In colDirList
If file1 = "" Then
file1 = varItem
counter = 1
ElseIf file2 = "" Then
file2 = varItem
counter = 2
ElseIf file3 = "" Then
file3 = varItem
counter = 3
End If
Next
'if there is more than 1 file, msgbox displays first 3 files
If counter = 1 Then
ListFiles = file1
ElseIf counter > 1 Then
MsgBox "Search has found Multiple files for '" & strFileSpec & "', first 3 files are: " & vbNewLine _
& vbNewLine & "file1: " & file1 & vbNewLine _
& vbNewLine & "file2: " & file2 & vbNewLine _
& vbNewLine & "file3: " & file3
ListFiles = "null"
Else
ListFiles = "null"
End If
Exit_Handler:
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function
Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional folders
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop
If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If
End Function
Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function