Makros - Mail mit Anhang und Pflichtfeld kombinieren
OK ich kann meine Nachricht nicht mehr anpassen. Hatte mich da etwas verrannt. Das passiert, wenn man immer husch husch macht. Also jetzt nochmal neu und diesmal auch funktionstüchtig und wahrscheinlich auch irgendwie so, wie du das gern wolltest...oh mann
Hier der Code für den Button. In diesem Fall, kann der Button beide Pfade beinhalten, denn der User wird vorher gefragt ob er die Tabelle als Mail versenden Möchte. Wenn er auf nein klickt, könnte man das WB auch speichern. Wie auch immer hier der Code
Ich habe die Pflichtfeldprüfung ausgelagert, falls du die auch in einer anderen Prozedur brauchen solltest. Wie du siehst wird das hier oben gleich als erstes abgefragt und dann danach die MSGBOX. Die kann man aber auch wieder rausnehmen. Ist selbsterklärend denke ich. Wenn dann auf ja geklickt wurde, wird die Outlook Routine gestartet.
Hier kommt die Outlookroutine. Fast unverändert, nur dass diesmal die Datei tatsächlich als .xlsx zwischen gespeichert wird. Außerdem wird der Dateiname noch etwas erweitert. Dazu unten mehr.
Wie du siehst gibt es zwei neue Funtionen. Einmal GetTempFolder und einmal GetFueller. Die erste gibt den Userspeziefischen Tempordner zurück und die zweite erweitert den Dateinamen um den Usernamen des Senders + dem aktuellen Datum. Das kann man aber beliebig in der Funktion anpassen. Sollte aber nicht leer sein, denn sonst funktioniert das Makro nicht mehr.
SaveTempFile arbeitet mit einem kleinen Workaround. Zuerst wird eine 1 zu 1 Kopie erstell, welche dann geöffnet wird um sie in eine .xlsx Datei umbenennen zu können. Die Kopie wird danach gelöscht. Das Ganze findet in dem Tempordner des Users statt. Ist nicht sehr schön, funktioniert aber.
Hier jetzt noch die beiden Hilfsfunktionen.
Wenn du jetzt all diese Funktionen in dein Userform kopierst, sollte es gehen.
Hier der Code für den Button. In diesem Fall, kann der Button beide Pfade beinhalten, denn der User wird vorher gefragt ob er die Tabelle als Mail versenden Möchte. Wenn er auf nein klickt, könnte man das WB auch speichern. Wie auch immer hier der Code
Code:
Private Sub CommandButton1_Click()
If AllePflichtfelderGefuellt Then
If MsgBox("Wollen Sie die Tabelle als EMail verschicken?", vbYesNo + vbQuestion) = vbYes Then
Call Excel_Workbook_via_Outlook_Senden
Else
'Hier kann irgendetwas anderes hin
End If
Else
MsgBox "Bitte Pflichtfelder ausfüllen!", vbOKOnly + vbExclamation, "Eingabefehler!"
End If
End SubCode:
Private Function AllePflichtfelderGefuellt() As Boolean
Dim rngPflicht As Range
Dim rngBereich As Range
Dim intLeere As Integer
Set rngPflicht = [B3,B9,E9,B11,B12,B13]
For Each rngBereich In rngPflicht.Areas
intLeere = intLeere + Application.WorksheetFunction.CountBlank(rngBereich)
Next
If intLeere = 0 Then
AllePflichtfelderGefuellt = False
Else
AllePflichtfelderGefuellt = True
End If
End FunctionCode:
Private Sub Excel_Workbook_via_Outlook_Senden()
Dim Nachricht As Object
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
'Aktive Arbeitsmappe wird als Mail gesendet
AWS = SaveTempFile(GetTempFolder & "\" & ThisWorkbook.Name, GetFueller)
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "xxx@xxx.de"
.Subject = "Bl. xxxx, Kurztext"
.attachments.Add AWS
.HTMLBody = "Hallo zusammen,<br><br>bitte laut Anhang tätig werden.<br><br>Danke und liebe Grüße,<br><br>"
'Hier wird die Mail nochmals angezeigt
.Display
End With
End SubCode:
Public Function SaveTempFile(ByVal strName As String, Optional ByVal strFueller As String = "") As String
Application.ScreenUpdating = False
Dim strFileName As String
Dim strFileType As String
Dim wb As Workbook
strFileType = Right(strName, 5)
strFileName = Left(strName, Len(strName) - 5) & strFueller
ThisWorkbook.SaveCopyAs strFileName & strFileType
Set wb = Application.Workbooks.Open(strFileName & strFileType)
Application.DisplayAlerts = False
wb.SaveAs strFileName & ".xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
wb.Close False
Kill strFileName & strFileType
SaveTempFile = strFileName & ".xlsx"
Application.ScreenUpdating = True
End FunctionHier jetzt noch die beiden Hilfsfunktionen.
Code:
Private Function GetFueller() As String
GetFueller = "_" & Environ("Username") & "_" & Format(Now, "ddmmyyyy")
End Function
Private Function GetTempFolder() As String
GetTempFolder = Environ("Temp")
End FunctionWenn du jetzt all diese Funktionen in dein Userform kopierst, sollte es gehen.
