Definiertes Namenfeld in Outlook als CC.
16.11.2013 10:34:16
Heinz
Im unteren Code wird mir im Sheets "Drucken" D201 bis 220 die Emailadressen in Outlook als CC eingetragen.
Nun habe ich D201-D220 als "Test" im Namenfeld definiert.
Es geht darum,ich möchte nicht alle 20 Emailadressen in CC. angezeigt haben.
Nun habe ich mir gedacht vielleicht funktioniert übers Namenfeld ?
Hätte jemand eine Lösung ?
Gruß Heinz
Option Explicit
Sub Als_PDF_speichern_versenden()
Dim pdfName As String
Dim pdfOpenAfterPublish As Boolean
Dim olApp As Object
Dim sPath As String
Dim strCopy As String, lngZeile As Long
pdfOpenAfterPublish = True ' PDF wird geöffnet
Rem Pfad und Name der PDF-Datei
With Sheets("Drucken")
pdfName = "Gesperrte Ware " & Sheets("Drucken").Range("B1").Text & ".pdf"
'pdfName = Environ$("Gesperrte Ware") & Format(Date - 1, "dddd dd mmmm yyyy") & ".pdf"
End With
Rem PDF-Datei erstellen. Funktioniert nur in Excel 2007 oder höher, _
nicht in Excel 2003 oder älter
Sheets("Drucken").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=IIf(pdfOpenAfterPublish, True, False)
Rem Email erstellen
'CC-Adressen einlesen aus D201:D220
With ActiveSheet
strCopy = .Cells(201, 4).Text '1. CC-Adresse einlesen
For lngZeile = 202 To 220
With .Cells(lngZeile, 4)
If .Text "" Then
strCopy = strCopy & ";" & .Text
End If
End With
Next
End With
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.To = Range("D200").Value
.CC = strCopy
'wenn das Datum in B1 schon im gewünsten Format steht
.Subject = "Gesperrte Ware " & Sheets("Drucken").Range("B1").Text
'wenn Datum im falschen Format in B1
' .Subject = "Gesperrte Ware " _
& Format(Sheets("Drucken").Range("B1").Value, "DDDD DD MMMM YYYY")
.Body = "Mit freundlichen Grüßen" & " " & "Der KE Vorarbeiter"
.Attachments.Add pdfName
.Display
End With
Rem Boolean-Variable "pdfOpenAfterPublish" zurücksetzen
pdfOpenAfterPublish = False
End Sub