auxmoney - Geld leihen für das Studiumauxmoney - Geld leihen für das Studium

auxmoney - Geld leihen für den Umzugauxmoney - Geld leihen für den Umzug

Mailversand aus Excel mit Outlook, Netscape oder Lotus

...sowie ohne Sicherheitsabfrage

Mailversand aus Excel mit Outlook, Netscape oder Lotus. SendMail, Send, Display
Makro zum Versenden von Excelblättern. Hier wird eine neue Datei angelegt, damit das ganze ohne
VBA Code versendet wird:
Sub ExcelSheet_Versenden()
Dim strMailEmpfaenger As String
i = Application.ActiveWorkbook.Path
strMailEmpfaenger = "Hier Mail-Adresse eintragen"
strTempName = "Abholauftrag Import.xls"
Sheets("Dein Tabellenname").Copy
ChDir i
ActiveWorkbook.SaveAs Filename:= i & "\" & strTempName
If Application.MailSystem <> xlNoMailSystem Then
Application.ActiveWorkbook.SendMail strMailEmpfaenger, _
"Abholauftrag Import von " & Application.OrganizationName, False
End If
ActiveWorkbook.Close
'Die temporär erstellte Arbeitsmappe wieder löschen
Kill i & "\" & strTempName
End Sub
Mail aus Excel mit Outlook versenden (ohne Sicherheitsabfrage):
Sub MailVersenden()
Dim outl, Mail As Object
Set outl = CreateObject("Outlook.Application")
Set Mail = outl.CreateItem(0)
Mail.Subject = "Bestellung " & VBA.Date
Mail.To = "sales@company.info"
Mail.CC = "admin@company.info; purch@company.info, boss@company.info"
Mail.BCC = "secret@company.info"
'Wichtigkeit Hoch (1 = normal, 0 = niedrig)
Mail.Importance = 2
'Standardtext
Mail.body = "Hallo Kollegen!" & vbCrLf & vbCrLf & _
"Anbei unser Auftrag." & vbCrLf & vbCrLf & _
"Mit freundlichen Grüssen" & vbCrLf & vbCrLf & _
"Euer Sales-Team" & vbCrLf & vbCrLf
'Eine Datei auf Laufwerk D:\ als Anhang mitsenden...
Mail.Attachments.Add "D:\Datei001.xls"
'oder: die aktive Exceldatei als Anhang mitsenden...
Mail.Attachments.Add ThisWorkbook.FullName
'Mail anzeigen
Mail.Display
'Ein sofortiger Mail-Versand geht in Firmen wegen Sicherheitseinstellungen oft nicht:
'Mail.Send
'aber es gibt eine Lösung mit SendKeys per Windows Scripting Host (Verweis ins VB-Projekt einfügen!):
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.AppActivate Mail
'Sendet ein "Alt-S", Outlook sendet Mail sofort ohne Sicherheitsabfrage:
WshShell.SendKeys ("%s")
Set Mail = Nothing
Set outl = Nothing
Set WshShell = Nothing
End Sub
Hinweise zur Lösung oben: das Versenden von zahlreichen Mails hintereinander sollte man hier unterlassen,
wenn der Bildschirm unruhig flackert (also ausschalten, wegschauen etc...).
Pech hat man auch, wenn die Rechtschreibprüfung eingeschaltet ist; diese lässt leider (noch) nicht
umgehen; bin hier für jeden Tipp dankbar...
Mail aus Excel mit Outlook versenden:
Sub Versenden()
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
bolStatusBar = Application.DisplayStatusBar
Set objOutlook = CreateObject("Outlook.Application")
strRecipient = "Preisanfragen_AV"
strFile = range("a2")
Application.StatusBar = "Sende Datei " & strFile & " an " & strRecipient
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add(strRecipient)
objOutlookRecip.Type = olTo
.Subject = strSubject
.Body = strFile
objOutlookRecip.Resolve
.Send
End With
Set objOutlook = Nothing
Application.StatusBar = False
Application.DisplayStatusBar = bolStatusBar
End Sub
 
Mail mit Netscape Messenger:
Öffnet den Netscape Messenger und hängt die aktuelle Datei als Anhang an.
Netscape Messenger ist hier der Standard-Mailclient.
Sub mail_ohne_outlook()
Application.Dialogs(xlDialogSendMail).Show "dein.name@hallo.com", "Ihre heutige Anfrage"
End Sub
 
Mail aus Excel über Lotus Notes (Notes-Client muss installiert sein):
'Set up the objects required for Automation into lotus notes
Public Sub SendNotesMail(Subject As String, Attachment As String, _
Recipient As String, BodyText As String, SaveIt As Boolean)
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you can pass an empty string
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, _
(Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.ISOPEN = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = Recipient
MailDoc.Subject = Subject
MailDoc.Body = BodyText
MailDoc.SAVEMESSAGEONSEND = SaveIt
'Set up the embedded object and attachment and attach it
If Attachment <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If
'Send the document
MailDoc.PostedDate=Now() 'Gets the mail to appear in the sent items folder
MailDoc.SEND 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub
 
Mailversand aus Worksheet heraus:
Die Daten für die Generierung der Email stehen in den Spalten A bis K:
A: Name des Empfängers
B: Emailadresse des Empfängers
C: Emailadresse für Kopie offiziell (optional)
D: Emailadresse für Kopie inoffizell (optional)
E: Betreff
F bis J: Texte, aus denen der Nachrichtentext generiert wird
K: Anhang (vollständiger Pfad & Dateiname - optional)
Über einen CommandButton in der Tabelle wird der Emailversand durchgeführt.
Im Code ist noch jede Menge auskommentiert, weil möglichst viele Möglichkeiten
für den Emailversand berücksichtigt werden sollen. So können verschiedene Anhänge
mitgesendet werden, der Emailversand kann automatisch oder über den Senden-Dialog
von Outlook erfolgen oder die weitere Makroausführung kann bis zum Beenden von
Outlook blockiert werden.
Sub cmdVersenden_Click()
Dim objOlApp As Outlook.Application
Dim objMailItem As Outlook.MailItem
Dim objMailRecip As Outlook.Recipient
Dim strMailAddress As String, strMailAddrCC As String
Dim strMailAddrBCC As String, strMailSubj As String
Dim strMailBody As String, strMailAttach As String
With ActiveSheet
If IsEmpty(.Cells(ActiveCell.Row, 11).End(xlToLeft)) Then
MsgBox "Bitte wählen Sie einen gültigen " & _
"Tabelleneintrag für den Email-Versand aus.", vbExclamation
Exit Sub
End If
'Die Daten für die Email befinden sich in den Spalten A bis K der Zeile mit der aktiven Zelle.
'Emailadressen auslesen
strMailAddress = .Range("B" & ActiveCell.Row)
If Not IsEmpty(.Range("C" & ActiveCell.Row)) Then
strMailAddrCC = .Range("C" & ActiveCell.Row)
End If
If Not IsEmpty(.Range("D" & ActiveCell.Row)) Then
strMailAddrBCC = .Range("D" & ActiveCell.Row)
End If
'Betreff der Nachricht auslesen
strMailSubj = .Range("E" & ActiveCell.Row)
'Nachricht generieren
strMailBody = strMailBody & .Range("F" & ActiveCell.Row) & " " & _
.Range("A" & ActiveCell.Row) & "," & vbLf & vbLf
strMailBody = strMailBody & .Range("G" & ActiveCell.Row).Text & "." & _
vbLf & vbLf
strMailBody = strMailBody & .Range("H" & ActiveCell.Row) & " ( " & _
Now & " ) " & vbLf & vbLf
'Abschluss und Absender hinzufügen
strMailBody = strMailBody & .Range("I" & ActiveCell.Row) & vbLf & _
.Range("J" & ActiveCell.Row) & vbLf & vbLf
'Pfad & Dateiname des Anhangs einlesen
strMailAttach = .Range("K" & ActiveCell.Row)
'Objektvariable für Anwendung festlegen
Set objOlApp = CreateObject("Outlook.Application")
On Error GoTo lNoOutlook
If objOlApp Is Nothing Then _
Set objOlApp = CreateObject("Outlook.Application")
'Objektvariable für neues Outlook-Element festlegen
Set objMailItem = objOlApp.CreateItem(olMailItem)
'Tritt beim Erstellen der Email ein Fehler auf, wird eine Fehlermeldung angezeigt.
On Error GoTo lNoSend
With objMailItem
'Empfänger der Mail wird in das Adressfeld "An:" geschrieben
Set objMailRecip = .Recipients.Add(strMailAddress)
'2. Empfänger für "Kopie offiziell" kennzeichnen
If strMailAddrCC <> "" Then
Set objMailRecip = .Recipients.Add(strMailAddrCC)
objMailRecip.Type = olCC
End If
'3. Empfänger für "Kopie inoffiziell" kennzeichnen
If strMailAddrBCC <> "" Then
Set objMailRecip = .Recipients.Add(strMailAddrBCC)
objMailRecip.Type = olBCC
End If
'Betreff der Mail wird in das Feld "Betreff:" geschrieben
objMailItem.Subject = strMailSubj
'Der Text der Nachricht wird übertragen
objMailItem.Body = strMailBody
'Falls ein Anhang mitgesendet wird
If strMailAttach <> "" Then
'Positon des Anhangs festlegen
'Einbetten einer Anlage in das Element
'.Attachments.Add Source:=strMailAttach, Type:=olByValue ', DisplayName:="Dateianhang"
'Wird DisplayName nicht angegeben, wird der Dateiname in der Mail angezeigt.
'DisplayName kann verwendet werden, um dem Anhang eine andere Bezeichnung zu geben.
'Erstellen einer Verknüpfung zu einem Outlook-Element z.B. Kontakt-Element
'.Attachments.Add Source:=strMailAttach, Type:=olEmbeddedItem
'Datei von einem Server durch Verknüpfen anhängen
'.Attachments.Add Source:=strMailAttach, Type:=olByReference
'OLE Anhang
'.Attachments.Add Source:=strMailAttach, Type:=olOLE
End If
'Übermittlungsbestätigung anfordern
'.OriginatorDeliveryReportRequested = True
'Lesebestätigung anfordern
'.ReadReceiptRequested = True
'Email in den "Gesendeten Objekten" speichern
'.Save
'Email als TXT-Datei speichern. Ohne Pfadangabe wird die Datei im Standard-Verzeichnis
'gespeichert...
'.SaveAs .Subject & ".txt", olTXT
'Direktes Senden der Email; ohne Onlineverbindung wird die Mail im Postausgang abgelegt
'.Send
'Email-Dialog anzeigen
.Display
'Dialog mit Bindung des Fensters; diese Einstellung ist beim Versenden von Mails mit
'Anhängen nicht empfehlenswert, weil während des Versendens keine weitere Makro-
'ausführung möglich ist
'MsgBox "Die Makroausführung wird bis zur Beendigung" & vbLf & _
"von MS Outlook unterbrochen.", vbInformation
'.Display (True)
End With
End With
GoTo lSetObjects
lNoSend:
MsgBox vbTab & "Eine E-Mail an die Adresse " & vbCrLf & vbCrLf & _
vbTab & EmailEmpfänger & vbCrLf & vbCrLf & _
"kann leider NICHT automatisch versendet werden."
GoTo lSetObjects
lNoOutlook:
MsgBox "Microsoft Outlook ist nicht installiert oder es ist kein" & vbLf & _
"Verweis auf die Microsoft Outlook Library gesetzt.", vbCritical
GoTo lSetObjects
lSetObjects:
Set objOlApp = Nothing
Set objMailItem = Nothing
Set objMailRecip = Nothing
End Sub
Mailversand aus Excel
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt