Email senden und abspeichern.

Forumthread: Email senden und abspeichern.

13.07.2015 09:27:07

Matthias

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?

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Email senden und abspeichern.

13.07.2015 09:50:19

Matthias

AW: Email senden und abspeichern.

13.07.2015 09:50:19

Matthias

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ß

Beliebteste Forumthreads (12 Monate)

Forumthread: Email senden und abspeichern.

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread