Attach files to an email message

First of all, I am using the following code to put files into a dedicated folder via a command button on a form.  Here's the code:

Private Sub cmdCreateCastingFolder_Click()
On Error GoTo Err_cmdCreateCastingFolder_Click

    Dim strAppName As String
    Dim strCastingPrintsDataPath As String

    strCastingPrintsDataPath = CreateDataFolder("Casting")
    
    If Len(strCastingPrintsDataPath) > 0 Then
        MsgBox _
            "The folder has been created on server.  Remember to place image files in this folder."
        strAppName = "explorer.exe " & strCastingPrintsDataPath
        Call Shell(strAppName, 1)
    Else
        MsgBox "An error has occurred. Please contact the system administrator.", _
            vbCritical + vbOKOnly
    End If

Exit_cmdCreateCastingFolder_Click:
    Exit Sub

Err_cmdCreateCastingFolder_Click:
    MsgBox "Error Number: " & Err.Number & vbCrLf & "Error Description: " & _
        Err.Description & vbCrLf & "Error Source: " & Err.Source
    Resume Exit_cmdCreateCastingFolder_Click

End Sub

Open in new window


The onload event of the Main Menu has this code:

Private Sub Form_Load()
On Error GoTo Err_Form_Load

    Dim strFilesDataPath As String
    
    strFilesDataPath = DLookup("FilesDataPath", "LOCALtblDatabaseSetup")
    If Not Right(strFilesDataPath, 1) = "\" Then strFilesDataPath = _
        strFilesDataPath & "\"
    TempVars!strFilesDataPath = strFilesDataPath

Exit_Form_Load:
    Exit Sub

Err_Form_Load:
    MsgBox Err.Description
    Resume Exit_Form_Load
    
End Sub

Open in new window


And in a setup table there is a field named "FiledDataPath" which as the location of the directory the files go into.

This is all working fine.  But now, if it is possible, I need to attach the files to an email message somehow.  The current code I am using to create the email message is:

    On Error Resume Next 'Keep going if there is an error
    Set olApp = GetObject(, "Outlook.Application") 'See if Outlook is open

    If Err Then 'Outlook is not open
        Set olApp = CreateObject("Outlook.Application") 'Create a new instance
    End If
    'Create e-mail item

    strSubject = "Request for Quotation - " & _
        Forms!frmQuotation.subfrmQuotationDetails.Form!txtPartRFQ
    strHTMLBody = _
        "<htmltags>Per the attached documents please quote best price and delivery for: <br><br>" _
        & Forms!frmQuotation.subfrmQuotationDetails.Form!txtPartNo & " - " _
        & Forms!frmQuotation.subfrmQuotationDetails.Form!txtPatternDescription _
        & "<br><br>" & _
        Me.txtPatternSpecInstructions _
        & "<br><br>" & _
        "Thank you for your prompt attention to this request." _
        & "<br><br>" & _
        "Regards," & _
        "<br>" & _
        Me.txtQuotationPreparer & _
        "<br>" & _
        Me.txtTitle & _
        "<br>" & _
        Me.txtCompany & _
        "<br>" & _
        Me.txtPhone & _
        "<br>" & _
        Me.txtEmail & _
        "<br><br> </htmltags>"
        
    
    For j = 1 To 5
        If Me("chkbxPatternSource" & j) = True Then
            Set objMail = olApp.CreateItem(olMailItem)
            strEmail = Me("txtPatternSourceEmail" & j) & ";"
            With objMail
                .To = strEmail
                .Subject = strSubject
                .HTMLBody = strHTMLBody
                .Send
            End With
        End If
    Next

    Set objMail = Nothing
    Set olApp = Nothing

Open in new window


So my question is, is it possible and if so, how would I alter the code to attach the files?

--Steve
SteveL13Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rey Obrero (Capricorn1)Commented:
revised your code to include a variable for the file to be attach

 dim strAttachment as string
 strAttachment=<completepath and filename>  
 
             With objMail
                .To = strEmail
                .Subject = strSubject
                .HTMLBody = strHTMLBody
                        
            .Attachments.Add strAttachment        ' add this line
                        
                .Send
            End With
SteveL13Author Commented:
Isn't working so far.

I added:

Dim strAttachment As String

strAttachment = Me.txtCastingPrintsDataPath   (because the data path is in this field on the form)

.Attachments.Add = strAttachment

Did I miss something?
Rey Obrero (Capricorn1)Commented:
where did you add

 
.Attachments.Add = strAttachment  ??????
Active Protection takes the fight to cryptojacking

While there were several headline-grabbing ransomware attacks during in 2017, another big threat started appearing at the same time that didn’t get the same coverage – illicit cryptomining.

Rey Obrero (Capricorn1)Commented:
and it is not  
.Attachments.Add = strAttachment

it should be


.Attachments.Add  strAttachment
SteveL13Author Commented:
Ok.  I removed the hyphen.  Here is where it is:

            With objMail
                .To = strEmail
                .Subject = strSubject
                .HTMLBody = strHTMLBody
                .Attachments.Add strAttachment
                .Send
Rey Obrero (Capricorn1)Commented:
so, is it working now? if it is not working, what is error?

what is the content of  Me.txtCastingPrintsDataPath ?
SteveL13Author Commented:
It is not working.  The content of  Me.txtCastingPrintsDataPath :

C:\TEMP\SLF Quotation Database\1\1\ABC123\Casting\

And there is one file in there named:

CNH_47861787_D_01_01_E_out.tif
Rey Obrero (Capricorn1)Commented:
"C:\TEMP\SLF Quotation Database\1\1\ABC123\Casting\"  this is only the path to the file

remember, you want to attach  a file

you need

"C:\TEMP\SLF Quotation Database\1\1\ABC123\Casting\CNH_47861787_D_01_01_E_out.tif"

as the  <completepath and filename>  that you will assign to the variable strAttachment
------------------------
try hardcoding it to the variable

strAttachment="C:\TEMP\SLF Quotation Database\1\1\ABC123\Casting\CNH_47861787_D_01_01_E_out.tif"


then test the codes...
SteveL13Author Commented:
That did work.  But how do I add the file name onto the path dynamically?
Rey Obrero (Capricorn1)Commented:
how did you create the file "CNH_47861787_D_01_01_E_out.tif"
SteveL13Author Commented:
It was a furnished file.  I just drag 'n dropped it in the folder (file path folder)
Rey Obrero (Capricorn1)Commented:
you need a vba function to get the complete path and file name to do this.
SteveL13Author Commented:
Ok.  I don't know how to do that.
SteveL13Author Commented:
Rey, you have been a huge help so far.  But do you know how to get  the complete path and file name?
Rey Obrero (Capricorn1)Commented:
place this function in forms module

Function fSelectFile(strPath As String)
Dim fd As Object, strAttachment
Set fd = Application.FileDialog(1)
With fd
    .Filters.Clear
    .Filters.Add "All Files", "*.*"

    .AllowMultiSelect = False
    
    'initial path
    .InitialFileName = strPath
    
    ' Set the title of the dialog box.
    .Title = "Select File to Attach"
        
    If .Show = True Then
        fSelectFile = .SelectedItems(1)
    End If
End With
End Function

Open in new window


then change your codes to this

dim strAttachment as string
  strAttachment=  fSelectFile(Me.txtCastingPrintsDataPath)
  
              With objMail
                 .To = strEmail
                 .Subject = strSubject
                 .HTMLBody = strHTMLBody
                         
             .Attachments.Add strAttachment        ' add this line
                         
                 .Send
             End With 

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.