Neu erzeugte Mappe als Attachement versenden?!?
08.03.2005 14:38:49
DonFiala
habe mir mit Hilfe vom Forum folgendes nettes Makro aus mehreren Einzelkomponenten zusammengebastelt. Im wesentlichen kopiert es ein Tabellenblatt, entfernt Verknüpfungen und sendet das ganze dann - nach dem Zwischenspeichern - als Attachement per Email.
Nun habe ich die zwischenspeicherfunktion entfernt und wollte das frisch erzeugte Tabellenblatt gleich als Email Anhang versenden, aber hab das nicht hinbekommen (Siehe Makroversuch). Geht das?
Gruss michi
Sub emailDaten()
ActiveSheet.Copy
ActiveSheet.Unprotect "Passoword"
'Dim WsShell, Rück%
' Set WsShell = CreateObject("WScript.Shell")
' Rück = WsShell.Popup("Datei wird für Speicherung vorbereitet. Bitte einen Augeblick Geduld...", 5 _
' , "Überschrift ...")
Dim Zelle As Range
'erste Verknüpfung finden
Set Zelle = Cells.Find(What:="]", LookIn:=xlFormulas)
If Not Zelle Is Nothing Then
Do
Zelle = Zelle.Value
Set Zelle = Cells.FindNext(Zelle)
Loop While Not Zelle Is Nothing
End If
'' Dim DName As String, Dateiname As String, Pfad As String
'' Pfad = Range("Y6")
'' DName = Range("V6")
'' Dateiname = Pfad & "\" & DName & Format(Now, "YYYY.MM.DD") & ".xls"
' Tagesdatum als "Jahr.Monat.Tag" wegen Exploreransicht!
'ActiveWorkbook.SaveAs Filename:=Dateiname
'ActiveSheet.Select
' ActiveWindow.Close SaveChanges:=0
'' On Error GoTo Fehler
'' ArbVerz = CurDir
'' ChDir Pfad
'' ChDir ArbVerz
'' ActiveWorkbook.SaveAs Filename:=Dateiname
''MsgBox "Datei wurde erfolgreich unter dem Namen " & ActiveWorkbook.Name & " gespeichert."
'ActiveWorkbook.Close
'Exit Sub
'Makro "senden" aufrufen (call kannste weglassen)
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
Dim D2Name As String
D2Name = "test@gmbh.com" 'Range("V7")
'Aktive Arbeitsmappe wird als Mail gesendet
AWS = ActiveWorksheet ' Pfad & "\" & DName & Format(Now, "YYYY.MM.DD") & ".xls"
' AWS = ThisWorkbook.FullName
InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = D2Name
' .To = "D2Name"
.Subject = "Zielerreichung" '& Date
HIER LIEGT DAS PROBLEM!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
.attachments.Add ActiveWorksheet 'AWS
.Body = "ZE." & vbCrLf & "Vielen Dank!"
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'Mail.Send
End With
' OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
ActiveWorkbook.Close
Exit Sub
Fehler:
If Err.Number = 1004 Then
MsgBox "Datei nicht gespeichert"
Else
MsgBox Err.Description: 'Exit Sub
End If
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End Sub