Outlook aus Excel-VBA (online-excel.de ; Ramses)
18.10.2012 14:26:56
Klaus
auf Online-Excel hat Ramses einen Code vorgestellt, mit dem sich Excel-Tabellen per VBA über Outlook verschicken lassen.
http://www.online-excel.de/excel/singsel_vba.php?f=86
Wenn ich den einfach mit Copy und Paste übernehme, ist mir bereits geholfen. Nur sehe ich im Code ein paar Zeilen, die vielleicht an 2010 angepasst werden müssten .. und dafür ersuche ich das Forum um Hilfe!
Sub Excel_Workbook_via_Outlook_Senden()
Dim MyMessage As Object, MyOutApp As Object
Dim Qe As Integer
Dim AWS As String
'Testen ob die aktuelle Mappe schon gespeichert wurde
If ThisWorkbook.Saved = False Then
'Die letzten Änderungen wurden noch nicht gespeichert
Qe = MsgBox("Diese Mappe wurde noch nicht gespeichert, und kann nicht versandt werden!" _
_
_
& Chr$(13) & "Soll die Datei gespeichert werden?", vbInformation + vbYesNo, " _
Sendefehler")
If Qe = vbNo Then
'Abbruch durch Benutzer
MsgBox "Sendevorgang abgebrochen"
Exit Sub
Else
'Prüfen ob die Datei schon mal gespeichert wurde
If Right(ThisWorkbook.Name, 3) "xls" Then
'Nein > Speicherdialog aufrufen
Application.Dialogs(xlDialogSaveAs).Show
Else
'Speichern
ThisWorkbook.Save
End If
End If
End If
'Aktive Arbeitsmappe wird als mail gesendet
'Übergabe des Mappennames an die Variable
AWS = ThisWorkbook.FullName
'Outlook Object erstellen
Set MyOutApp = CreateObject("Outlook.Application")
'Outlook Nachricht erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Empfänger
.To = "irgendwer@provider"
'Betreff
.Subject = "Testmeldung von Excel2000 " & Date & Time
.Attachments.Add AWS
'Hier wird ein normaler Text erstellt
.Body = "Mail für normalen Textempfang"
'Hier wird eine HTML Mail erstellt
'Dies kann zu Problemen führen, wenn der Empfänger
'nur TEXT Dateien empfangen darf.
'.HTMLBody = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt und gesendet
'.Send
End With
'Outlook schliessen
MyOutApp.Quit
'Variablen leeren
Set MyOutApp = Nothing
Set MyMessage= Nothing
End Sub
der Teil der Speicherroutine
'Prüfen ob die Datei schon mal gespeichert wurde
If Right(ThisWorkbook.Name, 3) "xls" Then
dürfte seit der Einführung von *.xlsx; *.xlsm usw nicht mehr funktionieren. Einfach auf "4" und "xlsm" hochsetzen kann ich die aber nicht, da die Datei ja auch *.xls heissen könnte ... was ist hier zu tuen?
Ganz am Ende schließt Outlook mit
'Outlook schliessen
MyOutApp.Quit
Hierdraus hätte ich gerne eine IF-Bedingung, die Outlook nur schließt wenn Excel es auch öffnen musste (ich hab den ganzen Tag Outlook offen, die meisten Kollegen auch). Wie kann ich den Pseudocode "IF Outlook=Open then ToQuitVariable = FALSE" denn VBA konform umsetzen?
Grüße und dank im Vorraus,
Klaus M.vdT.