Neue Arbeitsmappe per outlook versenden?
11.10.2005 09:25:48
ralle
Habe nachfolgendes Makro in eine Userform geschrieben.
Beim starten des Makros öffnet sich eine Maske in der Mann in einer Listbox die sheets der Excel-Arbeitsmappe gelistet werden. Hier können 1 oder mehrere sheets ausgewählt werden, die dann in eine neue Arbeitsmappe kopiert werden. In einer Combobox kann dann eine Emailadresse ausgesucht werden, an die dann diese neue Arbeitsmappe versand werden soll.
Wenn ich aber nun den Button "Abschicken" drücke wird nicht die neu erstellte Arbeitsmappe verschickt, sondern die Arbeitsmappe, in der das Makro ist.
Was mache ich falsch?
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