Versenden mit Outlook 2010

Forumthread: Versenden mit Outlook 2010

Heinz

Hallo Leute
Habe unteren Code von "Beverly gefunden.
Funktioniert auch.
Es versendet die Mail an: Cells(5, 1)
Nun möchte ich zusätzlich: CC: an Cells(8, 1)
Könnte mir dazu bitte jemand weiterhelfen?
Gruß
Heinz

Sub einzelnes_blatt_senden()
'* 24.08.06, 22.04.07                             *
'* erstellt von Karin (Beverly), http://Excel-Inn.de*
'* Beverly_Forums@web.de                          *
Dim strTabelle As String                ' Variable für den Tabellennamen
Dim wsTabelle As Worksheet              ' Variable für die Tabelle als Objekt
'   Tabelle2 als Standard festlegen
strTabelle = "Tabelle versenden"
'   Name der zu versendenen Tabelle abfragen
strTabelle = InputBox("Welches Blatt möchten Sie senden?" & vbCrLf & _
vbCrLf & "Bitte den Tabellennamen eingeben", , strTabelle)
'   kein Abbruch der Eingabe
If strTabelle  "" Then
'       Schleife über alle Arbeitsblätter
For Each wsTabelle In ThisWorkbook.Sheets
'           Name der Tabelle entspricht dem der zu versendenen Tabelle
If wsTabelle.Name = strTabelle Then
'               Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'               Tabelle komplett kopieren
Sheets(strTabelle).Copy
'               aktive Arbeitsmappe mit Mailbenachrichtigung "Diese Tabelle wurde als Mail  _
versandt" versenden
ActiveWorkbook.SendMail ThisWorkbook.Worksheets("Tabelle1").Cells(5, 1), "Diese  _
Tabelle wurde als Mail versandt"
'               aktive Arbeitsmappe schließen ohne Speichern
ActiveWorkbook.Close False
'               Bildschirmaktualisierung ein
Application.ScreenUpdating = True
'               Schleife verlassen
Exit For
Else
'               Tabelle mit dem eingegebenen Namen ist nicht vorhanden
If wsTabelle.Name = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name Then  _
MsgBox "Diese Tabelle gibt es nicht"
End If
Next wsTabelle
End If
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Versenden mit Outlook 2010

21.11.2011 18:57:35

Beverly

Hi Heinz,
um mit CC zu versenden, habe ich leider keine Lösung für diese Art zum Versenden. Du könntest aber die Mail 2 mal versenden, also auf diese Weise:

ActiveWorkbook.SendMail ThisWorkbook.Worksheets("Tabelle1").Cells(5, 1), "Diese  _
Tabelle wurde als Mail versandt"
ActiveWorkbook.SendMail ThisWorkbook.Worksheets("Tabelle1").Cells(8, 1), "Diese  _
Tabelle wurde als Mail versandt"

Oder - wenn du Outlook als Mailprogramm verwendest - könntest du es mit diesem Code versuchen:

Sub EMailVersendenOutlook()
Dim obNachricht As Object
Dim obMail As Object
ActiveSheet.Copy
ActiveWorkbook.SaveAs Environ$("temp") & "/" & "Anhang.xls"
Set obMail = CreateObject("Outlook.Application")
Set obNachricht = obMail.CreateItem(0)
With obNachricht
.To = ThisWorkbook.Worksheets("Tabelle1").Cells(5, 1)
.cc = ThisWorkbook.Worksheets("Tabelle1").Cells(8, 1)
.Subject = "Erinnerung"
.Body = "Liebe Kati," & vbLf & vbLf & "dein Termin ist am 01.12.2009 fällig." & vbLf _
& "Denke bitte unbedingt daran."
.ReadReceiptRequested = False
.attachments.Add Environ$("temp") & "/" & "Anhang.xls"
.send
End With
Set obNachricht = Nothing
Set obMail = Nothing
ActiveWorkbook.Close savechanges:=False
Kill Environ$("temp") & "/" & "Anhang.xls"
End Sub

AW: Versenden mit Outlook 2010

21.11.2011 20:14:20

Heinz

Hallo Beverly
Dieser Beitrag von heute hat mir sehr geholfen.

https://www.herber.de/forum/messages/1238800.html

Habe den Code für mich abgeändert.
Noch einmal recht herzlichen Dank,für deine Hilfe.
Gruß
Heinz

Private Sub Heinz1_Click()
Application.ScreenUpdating = False
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String, wksMail As Worksheet
Set wksMail = Sheets("Personalbesetzung") 'zu versendendes Blatt
AWS = Environ("USERPROFILE") & "\" & wksMail.Name & ".xls"
'temporäre Mappe erstellen
wksMail.Copy
With ActiveWorkbook
ActiveSheet.Shapes("Heinz1").Delete
ActiveSheet.Shapes("Heinz2").Delete
'########### Neu
ActiveSheet.Range("W5:Z19,Z40,B51:B95,Y51:Z72").Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearContents
'ActiveSheet.Range("W5").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 0
ActiveWindow.SmallScroll Down:=42
ActiveSheet.Range("Y51:Z72").Select
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 0
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.SmallScroll Down:=-93
ActiveSheet.Range("W5").Select
.SaveAs AWS
.Close
End With
Application.Visible = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "test@gmx.at"
.Cc = "test@aon.at"
.Subject = "Personalbesetzung KE " & "   " & "Schicht" & "  " & Worksheets(" _
Personalbesetzung").Cells(5, 21) & "     " & Worksheets("Personalbesetzung").Cells(5, 17)
.Attachments.Add AWS
.Body = "Mit freundlichen Grüssen" & vbNewLine & "  " & Worksheets("Personalbesetzung"). _
Cells(5, 11)
.Display
End With
Set OutApp = Nothing
Set Nachricht = Nothing
Kill AWS 'temporäre Mappe löschen
Application.ScreenUpdating = True
End Sub

AW: Versenden mit Outlook 2010

21.11.2011 20:18:42

Beverly

Hi Heinz,
das ist vom Prinzip her der selbe Code den ich in meinem vorhergehenden Beitrag gepostet habe.

Beliebteste Forumthreads (12 Monate)

Forumthread: Versenden mit Outlook 2010

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread