Einzelnes Tabellenblatt per Email versenden!
20.07.2004 09:30:17
DonFiala
habe mir mit viel Mühe folgendes Makro zusammengeklaut, aufgezeichnet und nachbearbeitet. Das geschützte Tabellenblatt wird in eine Neue Excel Datei unter einem im Ursprungstabellenblatt festgelegten Namen&Datum gespeichert!
Der Blattschutz wird hierfür aufgehoben! Der ertse Teil des Makros funktioniert soweit einwandfrei!
Dann soll dieses neue Tabellenblatt als Outlook Anhang versendet werden (Ideal wäre wenn ich wie mit dem Speichernamen im Excel einen Email Namen festlegen könnte) Leider wird immer die riesige Ursprungsdatei in den Anhang gepackt! Nehme mal an das liegt daran dass das Makro auch in der URsprungsdatei liegt?!
Weiss jmd. Rat? Das kann doch für Leute die net so planlos sind wie ich net so schwer sein?
Vielen Dank
ActiveSheet.Select
ActiveSheet.Copy
Cells.Select
ActiveSheet.Unprotect "Passwort"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
_
Dim DName As String, Dateiname As String, Pfad As String
Pfad = "\\Server\Firmendaten"
DName = Range("R2")
Dateiname = Pfad & "\" & DName & Format(Now, "YYYY.MM.DD") & ".xls"
' Tagesdatum als "Jahr.Monat.Tag" wegen Exploreransicht!
ActiveWorkbook.SaveAs Filename:=Dateiname
ActiveSheet.Select
'
Sub Excel_Workbook_via_Outlook_Senden()
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 = "irgendwer@provider"
.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
OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub