AW: ogottogott! owT
17.09.2015 13:57:57
matthias
So habe die Hilfe gelesen
dann sollte das ganze Also so gehen
Das Argument Index kann ein numerischer Wert oder eine Zeichenfolge sein, die den Titel des Objekts enthält.
Sub SeriendruckBEmail(ByVal strSheet As String)
'** Dimensionierung der Variablen
Dim strPDF As String
Dim OutlookApp As Object, strEmail As Object
Dim olOldBody As String
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 & "_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, 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("A8").Text & "_" _
& wksPrint.Range("A9").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
Set .SendUsingAccount = .Session.Accounts.Item("SKK Willmering")
olOldBody = .htmlBody
.To = wksData.Cells(iRow, 62).Value
.Subject = "Anspruchsmitteilung" & " " & wksPrint.Range("U1").Value
.body = "Hallo" & " " & wksPrint.Range("A8").Value & "," & Chr(13) & Chr(13) & _
_
"anbei wie vertraglich vereinbart deine Anspruchsmitteilung für den Monat" & " " & wksPrint. _
Range("U1").Value & " " & "zur weiteren Verwendung."
.Display 'Mail nur Anzeigen Nicht senden
VBA.SendKeys "^{END}", True
'Einfügen einer bestimmten Signatur
strSignatur = "SKK Willmering"
'strSignatur = "meineFirmenSignatur"
.GetInspector.CommandBars.Item("Insert").Controls("Signatur").Controls(strSignatur). _
_
Execute
.Attachments.Add File_PDF
.send
Sleep 15000 ' 2 Sekunden warten
Dim olApp As Object
Dim olName As Object
Dim olFolder As Object
Dim olMail As Object
Set olApp = GetObject(, "OutLook.Application")
Set olName = olApp.GetNamespace("MAPI")
Set olFolder = olName.Session.Folders("SKK Willmering").Folders("Gesendete Objekte")
Set olMail = olFolder.Items.GetLast
olMail.SaveAs FolderPDF & Format(Date, "yymmdd") & "_" & "B" & "_" & wksPrint.Range("A8").Text & _
"_" & wksPrint.Range("A9").Text & "_" & wksPrint.Range("U1").Text & ".msg", 3
On Error Resume Next
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
Geändert wurde die Zeile von
Set .SendUsingAccount = .Session.Accounts.Item(2)
auf
Set .SendUsingAccount = .Session.Accounts.Item("SKK Willmering")
Es kommt dann der Fehler
ungültiger Prozeduraufruf oder ungültiges Argument.
Der Accountname in Outlook heisst aber SKK Willmering.
?