Neue Arbeitsmappe per outlook versenden?

Private Sub cboemailliste_Change()
End Sub

Private Sub cmdAuswahlAnhang_Click()
Dim arr() As String
Dim irow As Integer, icounter As Integer
Dim spath As String
spath = Application.DefaultFilePath & "\"
For irow = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(irow) Then
icounter = icounter + 1
ReDim Preserve arr(1 To icounter)
arr(icounter) = Worksheets(ListBox1.List(irow)).Name
End If
Next irow
Worksheets(arr).Copy
End Sub

Private Sub cmdcancel_Click()
Unload Me
End Sub

Private Sub cmdListefüllen_Click()
End Sub

Private Sub cmdversenden_Click()
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
'Aktive Arbeitsmappe wird als Mail gesendet
AWS = ThisWorkbook.FullName
InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = Me.cboEmailliste.Value
.Subject = "Testmeldung von Excel2000 " & Date & Time
.attachments.Add AWS
.Body = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'Mail.Send
End With
'Outlook schliessen
OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub

Private Sub ListBox1_Click()
End Sub

Private Sub UserForm_Initialize()
Dim wks As Worksheet
For Each wks In Worksheets
ListBox1.AddItem wks.Name
Next wks
Me.cboEmailliste.RowSource = ("A1:A80")
'Me.cboEmailliste.ListIndex = "0"
End Sub