VBA Emailing subform records

[JSalle0826]

Hello all,

I'm completely new to the forum and to VBA. I have an Access database that I've built and been using at my company for years, and over these years I've managed to do almost anything to not use VBA because it is a complete foreign language to me.

I need some help with a form and subform that I've created where users create a supply order request for a customer and when they complete the request, they click on the "Add Record" button and I want an email to be sent to select parties that I've chosen.

Based on some internet searches, so far everything is working perfectly of what I've built/tweaked, the final hurdle for me is that I cannot get the details of the request contained in the subform to list in the email.

I've looked all over and cannot find anything...I've tried Loops and RecordsetClone, but as I've stated earlier, cannot understand it nor get it to work. If anyone can provide me any help, I would be extremely grateful.

Here is my code thus far and that I'm having trouble with the code in red...

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
Set fso = New FileSystemObject
Subjectline$ = "SUPPLY ORDER - " & [Forms]![Supply Requests]![Client ID].Column(1)

MyBodyText = "A new supply request has been entered into the database for fulfillment by " & [Forms]![Supply Requests]![Order Requestor].Column(1) & "!" & vbNewLine & vbNewLine & "Please click on the Incomplete Supply Orders button in the database to fulfill."
MyBodyText = MyBodyText & vbNewLine & vbNewLine & "Order Information:"
MyBodyText = MyBodyText & vbNewLine & vbNewLine & [Forms]![Supply Requests]![Client ID].Column(1)
MyBodyText = MyBodyText & vbNewLine & [Forms]![Supply Requests]![Address Line 1]
MyBodyText = MyBodyText & vbNewLine & [Forms]![Supply Requests]![Text35]
MyBodyText = MyBodyText & vbNewLine & vbNewLine & "Notes: " & [Forms]![Supply Requests]![Order notes]
MyBodyText = MyBodyText & vbNewLine & vbNewLine & "Order Specifics:"


MyBodyText = MyBodyText & vbNewLine & [Forms]![Supply Requests]![Supply Request Details Subform]![Quantity] & " " & [Forms]![Supply Requests]![Supply Request Details Subform]![Product ID].Column(1)


MyBodyText = MyBodyText & vbNewLine & vbNewLine & "Thank you!"

I cannot get it to cycle through all the records. I've tried loops and they don't work for me....

Currently the code, as displayed will send me the first item in the details form only...

Again, any help anyone could provide would be much appreciated.

Thanks.

Jeff

 

[JSalle0826]

Does anyone have any ideas about how to write the code to have all records in a subform appear in a VBA drafted email?

 

[Kiwiman]

Howzit

This is an what I have used to send a user all cost centres they have access to. In this case I am emailing the cost centre and the costcentrename

See if you can modify this:

Option Compare Database
Option Explicit
Dim sTo As String
Dim sCC As String
Dim sBCC As String
Dim sSub As String
Dim sBody As String
Dim strCC As String
Dim strRS as string

Dim db as DAO.Database
Dim rs as DAO.Recordset

Private Sub cmdEmail_Click()


' Original code copied from http://www.ozgrid.com/forum/showthread.php?t=51384
'Stop
Dim OutApp As Object
Dim OutMail As Object
Dim varPress As Variant

' Requery the subform in case of any dirty records
Me.frmUserCC.Requery

' Confirm that an email should be sent
strMess = "You are about to send an email notification to the user." & vbCrLf & vbCrLf
strMess = strMess & "Do you sish to continue?"

strStyle = vbYesNo
strTitle = "Send Notificaiton"

varPress = MsgBox(strMess, strStyle, strTitle)
If varPress = vbYes Then
    
    ' Get list of cost centres for the current user - this loops through all the subform records
    Get_CC
    
    ' Who to send it to
    sTo = Me.EmailAddress
    
    ' Wha is the subject
    sSub = "Overtime Model - User Setup \ Modification Confirmation"
    
    ' Write the body of the email
    sBody = Me.FirstName & vbCrLf & vbCrLf
    sBody = sBody & "You have now been setup \ your access rights modified for the Overtime model.  Your details are as follows:" & vbCrLf & vbCrLf
    sBody = sBody & "Role:  " & Me.Role & vbCrLf & vbCrLf
    sBody = sBody & "Sector:  " & Me.Sector & vbCrLf & vbCrLf
    sBody = sBody & "Cost Centres:" & vbCrLf
    sBody = sBody & strCC      ' This adds the list of cost centres to the body of the email
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    sCC = ""
    sBCC = ""
    
    With OutMail
        .To = sTo
        .CC = sCC
        .BCC = sBCC
        .Subject = sSub
        .Body = sBody
        .Send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End If


End Sub

Private Sub Get_CC()

Dim iCnt As Integer
    Select Case Me.Role
        Case "Admin"
            strCC = "You have access to ALL cost centres, based on the sector you select when you open the Excel file. "
        Case "Sector"
            strCC = "All cost centres for sector - " & Me.Sector
        Case Else
            
            ' As the user is not an admin or sector user, need to identify specific cost centres
            
            Set db = CurrentDb
            ' Define the recordset sql for the related table
            strRS = "SELECT T2.CostCentres, T1.CostCentreName "
            strRS = strRS & "FROM tblCostCentre T1 INNER JOIN tblCCAccess T2 ON "
            strRS = strRS & "T1.CostCentres = T2.CostCentres "
            strRS = strRS & "WHERE (((T2.Username)='" & Me.Username & "'));"

            Set rs = db.OpenRecordset(strRS)
            
            ' Check if records exist
            If rs.BOF And rs.EOF Then
                ' There are no cost centres fr the current user
                strCC = "No Cost Centres have yet been assigned.  Please contact the administrator"
            Else
                ' There is at least one cost centre for the user, therefore loop through recordset listing them in a variable
                rs.MoveLast
                rs.MoveFirst
                strCC = ""
                For iCnt = 1 To rs.RecordCount
                    strCC = strCC & rs(0) & " - " & rs(1) & vbCrLf
                    rs.MoveNext
                Next iCnt
            End If
            rs.Close
            Set rs = Nothing
            Set db = Nothing
    End Select

End Sub