Send data entered in Excel user form to Outlook

I have an Excel user form that I want the user to fill in and be able to press a command button (Submit for approval) on the form to create an Outlook email where they can then enter their supervisors email address once the email with the data from the form is created. All fields are text with the exception of a date picker. I have a separate command button that saves the record to another tab. Any assistance appreciated.Excel-User-Form.xlsmI have an Excel user form that I want the user to fill in and be able to press a command button (Submit for approval) on the form to create an Outlook email where they can then enter their supervisors email address once the email with the data from the form is created. All fields are text with the exception of a date picker. I have a separate command button that saves the record to another tab. Any assistance appreciated.
vierlamiAsked:
Who is Participating?
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.

broro183Commented:
hi Veirlami,

You may be able to modify the below code to use fields from your user form instead of ranges on a spreadsheet as it is currently written. I haven't used this for a while & have made some changes to generalise the code. Please let me know if you need any further help.

Option Explicit

Sub EmailCSVFile(PathAndFileToSend As String)
'sourced & modified from http://www.rondebruin.nl/mail/folder2/mail2.htm + other pages of Ron's
'This sub will send a newly created workbook with just the chosen file.
    Stop
    'sourced from:Automation of out look Mails based on the excel list
    'http://www.thecodecage.com/forumz/1054996151-post10.html
    'http://www.thecodecage.com/forumz/microsoft-outlook-forum/213688-search-new-email-text-make-bold-blue.html#post1055005238
    'RB: other constants to allow Late Binding*
    Const olFolderInBox As Long = 6
    Dim OutApp As Object
    Dim oNameSpace As Object
    Dim OutMail As Object
    Dim SigFile As String
    Dim Signature As String
    Dim ToStr As String
    Dim CCStr As String
    Dim SubjStr As String
    Dim BodyStr As String
    'find the user's email signature & define other variables
    'this is ignored if there is a value entered manually within the Notes sheet
    With Range("EmailSpecificSignaturePath")
        Select Case Len(.Value) = 0
            Case Is = True
                SigFile = Range("EmailDefaultSignaturePath").Value
                'set in workbook open as "D:\Documents and Settings\" & Environ("username") _
                 & "\Application Data\Microsoft\Signatures\Untitled.txt"
            Case Is = False
                SigFile = .Value
        End Select
    End With
    '    If Dir(SigFile) <> vbNullString Then
    If DoesFileFolderExist(SigFile) Then
        Signature = GetBoiler(SigFile)
    Else
        Signature = vbNullString
    End If
    'gather info from Notes sheet of file
    '### (these lines require on Named Ranges existing within your spreadsheet)
    ToStr = Range("EmailToStr").Value
    CCStr = Range("EmailCCStr").Value
    SubjStr = Range("EmailSubjectStr").Value
    BodyStr = Range("EmailBodyStr").Value


    'Save the new workbook/Mail it
    Set OutApp = CreateObject("Outlook.Application")

    'check for open Outlook session & open if necessary
    'sourced from: Microsoft Office Help - Microsoft Office Discussion - Excel VBA Programming - Access Programming
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    On Error GoTo 0

    '### may need modification
    If OutApp Is Nothing Then
        Set OutApp = CreateObject("Outlook.Application")
        Set oNameSpace = OutApp.GetNamespace("MAPI")
        oNameSpace.Logon , , True
        oNameSpace.GetDefaultFolder(olFolderInBox).Display
        'WasOutlookOpenedByCode = True
    End If

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = ToStr
        .CC = CCStr
        .BCC = vbNullString
        .Subject = SubjStr
        '        .Body = "Hi" & Chr(13) & Chr(13) & "Please find the " & .Subject & " attached." _
                 & vbNewLine & vbNewLine & Signature
        .body = BodyStr & vbNewLine & vbNewLine & vbNewLine & vbNewLine _
                & vbNewLine & Signature
        .Attachments.Add PathAndFileToSend
        .Save
        .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Public Function DoesFileFolderExist(strfullpath As String) As Boolean
'25/10/2010, RB: sourced from www.excelguru.ca/node/30 by Ken Puls
'note it only checks for the existence of the lowest folder (or the file) in the strfullpath string.
    On Error GoTo EarlyExit
    If Not Dir(strfullpath, vbDirectory) = vbNullString Then DoesFileFolderExist = True
EarlyExit:
    On Error GoTo 0
End Function

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    With ts
        GetBoiler = .readall
        .Close
    End With
    Set fso = Nothing
    Set ts = Nothing
End Function

Open in new window

0

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
vierlamiAuthor Commented:
Thank you for the quick response. I am still learning, so this will help me learn. I will modify the code and change the ranges to the fields on my user form.
0
broro183Commented:
Thankyou for the points.

Please post back in this thread if you have any problems with the code.

Goodluck
Rob
0
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 Excel

From novice to tech pro — start learning today.