Move email from personal sent items to generic sent items

twoplustwo

Registered User.
Local time
Today, 05:06
Joined
Oct 31, 2007
Messages
507
Morning guys!

Below is code to ship an email pulling client details from the open form.

I need to move the sent items from my personal sent items to folder to the generic team email folder (sent items).

Any ideas on how to perform this?

Code:
Private Sub btnShipEmail_Click()     'Ships email to the selected contacts

Dim strContactEmail As String        'Contact email address
Dim strCustomer As String            'Customer Name
Dim strSite As String                'Site Name
Dim strContactFirstName As String    'Contact First Name
Dim strContactSecondName As String   'Contact Surname
Dim strContPosition As String        'Contact Position
Dim strContPhone As String           'Contact Phone
Dim strEmailText As String           'Email body text
Dim strEmailSubject As String        'Email subject
Dim strMC_Forecasts As String        'Forecasting email
Dim rsContactActions As Recordset    'Opens contact actions recordset for update
Dim db As Database                   'Current db

'On Error GoTo err_btnShipEmail_Click

strContactEmail = Forms!frmSummerShut2008.lstContacts.Column(6)         'Set email from selected customer
strCustomer = Me.CompanyName                                            'Set company  name
strSite = Me.SiteName                                                   'Set site name
strContactFirstName = Forms!frmSummerShut2008.lstContacts.Column(3)
strContactSecondName = Forms!frmSummerShut2008.lstContacts.Column(4)
strContPosition = Forms!frmSummerShut2008.lstContacts.Column(10)
strContPhone = Forms!frmSummerShut2008.lstContacts.Column(5)

strEmailSubject = "**TEST** MY COMPANY - Summer 2008 Consumption  - Request for Information" 'Set subject of email

strEmailText = "**TEST ** MY COMPANY – Summer 2008 Shutdown Enquiry" & Chr$(13) & _
               Chr$(13) & "It is important for MY COMPANY that we know what power our customers are likely to consume. During holiday periods when consumption patterns can change this becomes more difficult." & Chr$(13) & _
               Chr$(13) & "To assist us we are asking some of our larger customers to provide information about their intentions over the Summer Holiday period. We are particularly interested in the period 2oth July – 14 August 2008 but if you have a summer shutdown outside this period then please let us know." & Chr$(13) & _
               Chr$(13) & "Please complete the attached spreadsheet by Monday 10 July 2008 and return it to forecasts@mycompany.com even if you do not expect your consumption to differ from your normal consumption pattern." & Chr$(13) & _
               Chr$(13) & "Site:" & " " & strCustomer & ":  " & strSite & Chr$(13) & _
               Chr$(13) & "Please amend the contact details for queries relating to this information if the primary contact is different from that given below. Complete the details if any information is missing and return to forecasts@british-energy.com" & Chr$(13) & _
               Chr$(13) & "Name:" & " " & strContactFirstName & " " & strContactSecondName & Chr$(13) & _
               Chr$(13) & "Position:" & " " & strContPosition & Chr$(13) & _
               Chr$(13) & "Telephone:" & " " & strContPhone & Chr$(13) & _
               Chr$(13) & "Email Address:" & " " & strContactEmail & Chr$(13) & _
               Chr$(13) & "The Demand Forecasting team thank you for your efforts."

If Not IsNull(Forms!frmSummerShut2008.lstContacts.Column(6)) Then 'Write email if and address can be found in contact details

Set db = CurrentDb
Set rsContactActions = db.OpenRecordset("tblContactActions", dbOpenTable) 'Open contact actions recordset for update
'Set strBE_Forecasts = "forecasts@british-energy.com"

DoCmd.SetWarnings False

DoCmd.SendObject acSendNoObject, , , Forms!frmSummerShut2008.lstContacts.Column(6), , , strEmailSubject, strEmailText, True
  
  rsContactActions.AddNew 'Update recordset email sent field
        rsContactActions("Notes") = "Email request for information sent"
        rsContactActions("ActionType") = 1
        rsContactActions("ActionDate") = Date
        rsContactActions("ContactID") = Me.OpenArgs
        rsContactActions.Update
        Me.Requery
        
    End If
                
Exit_Function:
    If Not IsNull(rsContactActions) Then
        rsContactActions.Close
        Set db = Nothing
    End If
                
End Sub
 

Users who are viewing this thread

Back
Top Bottom