Sub AutoNew()
Application.Visible = False
UserForm1.Show
End Sub

Private Sub UserForm1_Initialize()
Me.Caption = "Escalation"
Me.Label1.Caption = "SVM #:"
Me.Label2.Caption = "Claim #:"
Me.Label3.Caption = "Customer Name:"
Me.Label4.Caption = "Provider # and/or name:"
Me.Label5.Caption = "Reason for escalation:"
Me.CommandButton1.Caption = "Submit"
End Sub


Private Sub UserForm_Terminate()
Application.Quit SaveChanges:=False
End Sub

Private Sub CommandButton1_Click()

    Set SVM = ActiveDocument.Bookmarks("SVM").Range
    SVM.Text = Me.TextBox1.Value
    
    Set Claim = ActiveDocument.Bookmarks("Claim").Range
    Claim.Text = Me.TextBox2.Value
    
    Set Customer = ActiveDocument.Bookmarks("Customer").Range
    Customer.Text = Me.TextBox3.Value
    
    Set Provider = ActiveDocument.Bookmarks("Provider").Range
    Provider.Text = Me.TextBox4.Value
    
    Set Reason = ActiveDocument.Bookmarks("Reason").Range
    Reason.Text = Me.TextBox5.Value
    

Static running As Boolean
If running Then Exit Sub
If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Or TextBox4 = "" Or TextBox5 = "" Then MsgBox "All fields are required. Complete the form before clicking submit.": Exit Sub
running = True

Dim objOutlook As Object
Dim objOutlookMsg As Object
Dim objInspector As Object
Dim objDoc As Word.Document
Dim objRange As Range

    ActiveDocument.Content.Copy
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        MsgBox "Outlook is not running."
        GoTo lbl_Exit
    End If
    On Error GoTo 0

    Set objOutlookMsg = objOutlook.CreateItem(0)
    With objOutlookMsg
        .to = "email"
        .cc = "email"
        .Subject = "Escalation"
        Set objInspector = .GetInspector
        Set objDoc = objInspector.WordEditor
        Set objRange = objDoc.Range(0, 0)
        .Display
        objRange.Paste
        .send
    End With
lbl_Exit:
    Set objDoc = Nothing
    Set objRange = Nothing
    Set objOutlookMsg = Nothing
    Set objInspector = Nothing
    Set objOutlook = Nothing
    Exit Sub
End Sub