AW: Pdf aus exteren Ordner per Email aus Excel senden
19.10.2015 08:50:43
matthias
Hallo,
Besten Dank für die Info.
Ich muss hier weiter ausholen.
Nochfolgend mein bisheriger Code. Ich kanne damit ein Tabellensheet als PDF erstellen lassen. Diese wird dann nachschließend per Email versendet. Desweiteren läuft eine If-Schleife bezogen das sheet strSheet.
Das strsheet wird vorab über ein Dropdownmenü ausgewählt.
Nun ist es jedoch so, dass bevor die Emails versendet werden, ich den Anhang ausdrucken muss, um diese unterschreiben zu lassen.
Die eingescannten unterschriebenen Dokumente würde in einem Ordner Scans speichern der im gleichen Verzeichnis wie die Excel-Datei liegt.
Nun möchte ich gerne per Button, den Ordner durchsuchen (Pdf-Name ist die laufende Nummer ab 1) und mit den laufenden Nummern in Spalte A (ab Zeile 8) des ausgewählten Sheets in dem Dropdownmenü abgleichen lassen. Danach sollte die eingescannte PDF an die in Spalte B der betreffenden Zeile stehenden Emailadresse versendet werden.
Jedoch habe ich keinen Plan wie ich die externe Datei über Excel einlesen soll.
Hat hierzu wer eine Idee?
Sub SeriendruckVEmail(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("V") 'Name des zu drucken Blatts ggf. anpassen
iRow = 8
FolderPDF = ActiveWorkbook.Path & Application.PathSeparator & "_11_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, 51).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("A5").Text & "_" _
& wksPrint.Range("A6").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 = "Verzichterklärung" & " " & wksPrint.Range("U1").Value
.body = "Hallo" & " " & wksPrint.Range("A6").Value & "," & Chr(13) & Chr(13) & _
_
"aanbei wie gewünscht deine Verzichterklärung für den Monat" & " " & wksPrint.Range("U1"). _
Value & " " & "zur weiteren Verwendung." & Chr(13) & Chr(13) & "Wir bitten um Prüfung. Eventuelle Korrekturen bzw. Anpassungen dieser Verzichterklärung können binnen einer Frist von 3 Tagen noch schriftlich eingereicht werden. Ansonsten bist du mit der im Anhang befindlichen Verzichterklärung einverstanden und die Zuwendungsbestätigung wird erstellt. Der Differenzbetrag zwischen deinen Ansprüchen und deiner Verzichterklärung wird auf dein Konto erstattet." & 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