Private Sub Userbutton_Click()

Dim Computer As String
Computer = FindCompName
Register_address = "products@waa-inc.com"
subject_text = "User information for the full copy of ProjeX " & This_Version
message_text = "Username " & Application.Username & "%0ACompany name " & Application.OrganizationName & "%0A" & "Computer " & Computer & _
                "%0A" & "Do not change the header or message text, just send direct please"
    
On Error GoTo Oh_fuck

    ActiveWorkbook.FollowHyperlink Address:="mailto:" & Register_address & "?subject=" & subject_text & _
     "&body=" & message_text
    
    Exit Sub
Oh_fuck:
    MsgBox "Error emailing " & Register_address, vbOKOnly + vbCritical, "Error"
End_it:
End Sub 

Sub CreateOutlookMail()
Dim olApp As Outlook.Application
Dim olMailMessage As Outlook.MailItem
' Create new instance of Outlook or open current instance.
Set olApp = New Outlook.Application
' Create new message.
Set olMailMessage = olApp.CreateItem(olMailItem)
With olMailMessage
.Subject = "Testing mail by Automation"
.Body = "This message was created by VBA code running Outlook through Automation." _
& Chr( 13 )
.Attachments.Add Application.ActiveWorkbook.Path & "\" & _
Application.ActiveWorkbook.Name, olByReference
.Display
End With
Set olMailMessage = Nothing
olApp.Quit
Set olApp = Nothing
End Sub

Option Explicit

Const MAX_CHARS =  20 

Sub Test()
    Call SendRangeWithOutlook(Selection)
End Sub

Private Sub SendRangeWithOutlook(rng As Excel.Range)

    Dim ol As Outlook.Application

    On Error Resume Next

    Set ol = GetObject(, "outlook.application")

    If ol Is Nothing Then _
        Set ol = CreateObject("outlook.application")

    If Not ol Is Nothing Then

        Dim item As Outlook.MailItem: Set item = ol.CreateItem(olMailItem)

        With item
            .Subject = "Test-Mail"
            .Body = RangeToText(rng)
            .To = "test@test.de"
            .Send
        End With

        Set item = Nothing
        Set ol = Nothing

    End If

End Sub

Private Function RangeToText(rng As Excel.Range, Optional Delimiter As String = vbTab) As String

    Dim chars As String * MAX_CHARS

    Dim result As String
    Dim i&, j&
    
    For i =  1  To rng.Rows.Count
        For j =  1  To rng.Columns.Count
            chars = rng(i, j)
            result = result & chars & Delimiter
        Next
        result = Trim$(result) & vbCrLf
    Next

    RangeToText = result

End Function