Email senden und abspeichern.

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Email senden und abspeichern.
von: Matthias
Geschrieben am: 13.07.2015 09:27:07

Hallo,
ich kann mittels eines Code aus Excel eine PDF Datei erstellen und diese dann per Email senden.
Kann man auch die E-Mail irgednwie automatisch gleich abspeichern mittels einer Befehlszeile?

Bild

Betrifft: AW: Email senden und abspeichern.
von: Matthias
Geschrieben am: 13.07.2015 09:50:19
Ich benutze dazu nachfolgenden Code.

Private Sub CommandButton30_Click()
 With Me.ComboBox8
    If .ListIndex = -1 Then
      MsgBox "Es wurde noch kein Blatt mit Daten in der Combobox ausgewählt!"
    Else
      Me.Hide 'zwingend erforderlich, wenn mit PrintPreview gearbeitet wird
       ActiveWorkbook.Worksheets("B").Unprotect PW
      Call SeriendruckBEmail(strSheet:=Me.ComboBox8.Value)
       ActiveWorkbook.Worksheets("B").Protect PW
      Me.Show
    End If
  End With
End Sub
im Modul
Sub SeriendruckBEmail(ByVal strSheet As String)
'** Dimensionierung der Variablen
Dim strPDF As String
Dim OutlookApp As Object, strEmail As Object
Dim wksData As Worksheet, wksPrint As Worksheet
Dim iRow As Integer
Dim FolderPDF As String, File_PDF As String
On Error GoTo Fehler
Set wksData = ActiveWorkbook.Worksheets(strSheet)
Set wksPrint = ActiveWorkbook.Worksheets("B") 'Name des zu drucken Blatts ggf. anpassen
iRow = 8
FolderPDF = ActiveWorkbook.Path & Application.PathSeparator & "E-Mail"
If Dir(FolderPDF, vbDirectory) = "" Then
VBA.MkDir FolderPDF
End If
FolderPDF = FolderPDF & Application.PathSeparator
Do Until IsEmpty(wksData.Cells(iRow, 1))
If UCase(wksData.Cells(iRow, 40).Value) = "A" Then 'Wert in Spalte D prüfen
wksPrint.Range("T1").Value = wksData.Cells(iRow, 1).Value 'lfd. Nr
wksPrint.Range("U1").Value = strSheet
wksPrint.Calculate '???? - wenn Formelberechnungen aktualisiert werden müssen
File_PDF = FolderPDF & wksPrint.Range("A13").Text & "_" _
& wksPrint.Range("A14").Text & "_" & wksPrint.Range("U1").Text & ".pdf" 'Zellen und verbindenden Text ggf. anpassen
wksPrint.ExportAsFixedFormat Type:=xlTypePDF, Filename:=File_PDF, _
Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set OutlookApp = CreateObject("Outlook.Application")
Set strEmail = OutlookApp.CreateItem(0)
With strEmail
.To = wksData.Cells(iRow, 62).Value
.Subject = "Anspruchsmitteilung" & " " & wksPrint.Range("U1").Value
.body = "Hallo" & " " & wksPrint.Range("A14").Value & "," & Chr(13) & Chr(13) & _
"anbei wie vertraglich vereinbart deine Anspruchsmitteilung für den Monat" & " " & wksPrint.Range("U1").Value & " " & "zur weiteren Verwendung." & Chr(13) & Chr(13) & "Mit sportlichen Gruß" & Chr(13) & Worksheets("GD").Range("$AJ$3").Value & " " & "-" & " " & Worksheets("GD").Range("$AJ$4").Value

.Attachments.Add File_PDF
.Send
End With
Kill File_PDF
End If

iRow = iRow + 1
Loop
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case 9
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& "Blatt """ & strSheet & """ ist nicht vorhanden!"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub
Kann man den so erweitern, dass die Email auch noch zugleich in einem definierten Ordner von mir archiviert wird?
Gruß

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Email senden und abspeichern."