Anzeige
Archiv - Navigation
1236to1240
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Outlook 2010 senden & an CC

Outlook 2010 senden & an CC
Heinz
Hallo Leute
Wir haben in der Firma seit heute auf Oulook 2010 (vorher Novell) umgestellt.
Nun funkt.mein Makro nicht mehr wie gewünscht.
Ich möchte das mir die Mappe an die mailadresse von Cells(10, 23) & CC an die mailadresse von Cells(14, 23) gesendet wird.
Könnte mir bitte damit jemand weiterhelfen ?
Gruß
Heinz
Private Sub Heinz1_Click()
If ActiveWorkbook.Name  ThisWorkbook.Name Then Exit Sub
Call BlattSchutz_Aufheben
If MsgBox("Soll die Personalbesetzung vom" & "  " & Worksheets("Personalbesetzung").Cells(5, 17) _
& " " & "Schicht" & _
" " & Worksheets("Personalbesetzung").Cells(5, 21) & " " & "an" & " " & Worksheets(" _
Personalbesetzung").Cells(10, 23) & _
"  " & "und an " & Worksheets("Personalbesetzung").Cells(14, 23) & " " & "gesendet werden?",  _
vbYesNo) = vbYes Then
End If
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Outlook 2010 senden & an CC
31.10.2011 17:50:16
Hajo_Zi
Hallo Heinz,
vielleicht solltest Du dann auch den Code zum Mailen posten? Nur wenige schauen auf Deinen Rechner.
Ansonsten schaue mal auf die Seite von Beverly, vielleicht findest Du dort was?

AW: Outlook 2010 senden & an CC
31.10.2011 18:26:35
Heinz
Hallo Hajo
Das wäre nun mein Code
Option Explicit
Sub einzelnes_blatt_senden()
If ActiveWorkbook.Name  ThisWorkbook.Name Then Exit Sub
Dim strTabelle As String                ' Variable für den Tabellennamen
Dim wsTabelle As Worksheet              ' Variable für die Tabelle als Objekt
'   Tabelle2 als Standard festlegen
'ActiveSheet.DrawingObjects.Visible = False
strTabelle = "Personalbesetzung"
'   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
'        Alles in der Copy im Tabellenblatt löschen
ActiveSheet.Shapes("Heinz1").Delete
Dim Ding As Object
For Each Ding In ActiveWorkbook.VBProject.VBComponents
'Type 100 = DieseArbeitsmappe und alle Tabellen
If Ding.Type = 100 Then
With ActiveWorkbook.VBProject.VBComponents(Ding.Name).CodeModule
.DeleteLines 1, .CountOfLines
Range("W5:Z19,Z40,B51:B95,Y51:Z72").Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearContents
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
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
Range("Y5").Select
End With
End If
Next
'aktive Arbeitsmappe mit Mailbenachrichtigung "Diese Tabelle wurde als Mail versandt" versenden
ActiveWorkbook.SendMail ThisWorkbook.Worksheets("Personalbesetzung").Cells(14,  _
26), "Personalbesetzung" & _
" " & Worksheets("Personalbesetzung").Cells(5, 17) & " Schicht " & Worksheets(" _
Personalbesetzung").Cells(5, 21)
ActiveWorkbook.SendMail ThisWorkbook.Worksheets("Personalbesetzung").Cells(10,  _
26), "Personalbesetzung" & _
" " & Worksheets("Personalbesetzung").Cells(5, 17) & " Schicht " & Worksheets(" _
Personalbesetzung").Cells(5, 21)
'               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
'ActiveSheet.DrawingObjects.Visible = True
End Sub
Gruß
Heinz
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige