Tabelle senden, VBA

Hallo liebe VBA-Profies!
Ich habe folgenden Code aus dem Internet runtergeladen, der auch super funktioniert.
Der Code ist einfach und hängt das aktuelle Blatt an Outlook nur an. So will ich das auch. Weil man danach die Email frei und individuell schreiben kann.

Sub TabellenblattVerschicken()
ActiveSheet.Copy
Application.Dialogs(xlDialogSendMail).Show _
"empfänger@mailanbieter.de", "Dienstplan"
End Sub

Allerdings kann nicht die Dateiname automatisch generieren.
Dateiname soll aus folgenden drei Worten Bestehen
Dienstplan_Monat_Gruppenname
Aktueller Monat ist im: Planer!$I$2
Und Gruppenname ist im: Planer!$S$2
Planer ist der Blattname, wo sich die Zellen I2 udn S2 befinden.
Ich habe auch einige Codes aus dem Internet runtergeladen und versucht sie anzupassen. Es klappt nicht.
Anscheinend muss ich dabei viele Sachen beachten und ich kenne mich mit VBA nicht aus.
Kann mir jemand vielleicht helfen?
Danke im Voraus
LG
Ahmadi

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ahmadi,
mit einem vorgegeben Datei-Namen für die Datei mit dem kopierten Blatt kann es für Outlook als E-Mail-Programm etwa wie folgt aussehen.
Wenn die Anhänge im neueren Format als xlsx-Datei angehängt werden sollen, dann muss du sie als Kommentar eingefügten Zeilen für den Dateinamen und das Speichern unter verwenden.
Gruß
Franz

Sub Send_Mail_with_Attachment()
Dim strPfad As String, strAttachment As String
Dim olApp As Object
Dim wksCopy As Worksheet
Dim wkbCopy As Workbook
Dim wkbAktiv As Workbook
Set wkbAktiv = ActiveWorkbook
With wkbAktiv
strPfad = .Path & "\" 'ggf. anders setzen/festlegen
With .Worksheets("Planer")
'            strAttachment = strPfad & "Dienstplan_" & .Range("I2").Text & "_" & .Range("S2"). _
Text & ".xlsx"
strAttachment = strPfad & "Dienstplan_" & .Range("I2").Text & "_" & .Range("S2"). _
Text & ".xls"
ActiveSheet.Copy
Set wkbCopy = ActiveWorkbook
Set wksCopy = wkbCopy.Sheets(1)
With wksCopy
.Unprotect "save"
.UsedRange.Copy
.UsedRange.PasteSpecial Paste:=xlPasteValues
Range("A1").Select
.Protect "save"
End With
End With
Application.DisplayAlerts = False
'        wkbCopy.SaveAs Filename:=strAttachment, FileFormat:=51 '51 = xlOpenXMLWorkbook - xlsx
wkbCopy.SaveAs Filename:=strAttachment, FileFormat:=-4143 '-4143 = xlWorkbooknormal -  _
xls
wkbCopy.Close savechanges:=False
Application.DisplayAlerts = True
End With
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.to = "empfänger@mailanbieter.de" 'Empfänger
'.cc = "test@test.de" 'optional Kopie an
'.bcc = "mail1@server.de,mail2@server.de,mail3@server.de" 'optional Blindkopie an
.Subject = "Dienstplan" 'Betreff optional
.body = "Liebe Kolleginnen und Kollegen" & Chr(13) & Chr(13) _
& "hier der neue Dienstplan für " & wkbAktiv.Worksheets("planer").Range("I2") _
& Chr(13) & Chr(13) _
& "Mit freundlichen Grüßen" & Chr(13) & Chr(13) _
& "Mister X"
.Attachments.Add strAttachment
.display
End With
Set wkbAktiv = Nothing: Set wkbCopy = Nothing: Set wksCopy = Nothing
Set olApp = Nothing
'    Kill strAttachment 'löscht die erstellte Datei - ggf. aktivieren
End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread