Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1444to1448
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Anderes Email Postfach auswählen

Anderes Email Postfach auswählen
04.09.2015 18:52:59
matthias
hallo,
habe nochfolgenden Code
Sub SeriendruckBEmail(ByVal strSheet As String)
'** Dimensionierung der Variablen
Dim strPDF As String
Dim OutlookApp As Object, strEmail As Object
Dim olVerz As Outlook.MAPIFolder
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 olVerz = Application.GetNamespace("MAPI").Folders.Item("SKK Willmering")
Set strEmail = OutlookApp.CreateItem(0)
With strEmail
.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." & 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
Sleep 2000  ' 2 Sekunden warten
Dim olApp As Object, objMail As Object
Set olApp = GetObject(, "OutLook.Application")
Set objMail = olApp.Session.GetDefaultFolder(5).Items.GetLast
objMail.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
Damit Erzeuge ich anhand eines Kriterium eine PDF versende die per Email und speichere die Email ab.
Nun habe ich aber zwei Postfächer in Outlook und die Email sollen nur über ein bestimmtes Postfach B gesendet werden.
Geht das auch irgendwie automatisch oder muss ich wirklich immer zuerst das Standardpostfach auf B wechseln?
Gruß+Danke

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Anderes Email Postfach auswählen
04.09.2015 19:51:22
mumpel
Hallo!
Setze vor ".to" die Zeile Set .SendUsingAccount = .Session.Accounts.Item("Kontoname")
Gruß, René

AW: Anderes Email Postfach auswählen
04.09.2015 20:37:48
matthias
Fehler Nr 5
ungültiger Prozeduraufruf oder Argument?
Die Variable muss ich ja hier nicht deklarieren.
Kann es sein, dass ich den falschen Accountnamen habe? Wo findet man den Accountnamen?

AW: Anderes Email Postfach auswählen
04.09.2015 20:42:47
matthias
Hallo,
habe den Fehler gefunden Nach Items nummer die laufende Numme stehen.
Ein problem bleibt, die letzte Mail aus dem Standard Ordner wird gespeichtert, kann man hier auch so in Account wechseln?

Anzeige
AW: Anderes Email Postfach auswählen
04.09.2015 22:31:25
mumpel

Zitat:
die letzte Mail aus dem Standard Ordner wird gespeichtert, kann man hier auch so in Account wechseln?
____________________________
Quelle: Herber-Forum


Wie genau meinst Du das?

AW: Anderes Email Postfach auswählen
04.09.2015 22:56:05
matthias
in meinen code ist eine Stelle drin, die nach dem Senden der Email eigentlich die Email abspeichert.
hat alles wunderbar funktioniert.
Nun habe ich ja diesen zweiten Account, der aber als Standard definiert ist.
Deshalb habe ich eine Anweisung benötigt, die bevor die Email versendet wird den Account wechselt.
Funktioniert auch super.
Aber die Datei die dann abgespeichert wird, ist nicht die letzte Datei die in dem neu gewählten Account versendet wurde sondern die letzte Datei im Standardordner.
Und ich bekomme es einfach nicht hin.
Weis hier jemand Rat

Anzeige
AW: Anderes Email Postfach auswählen
05.09.2015 10:04:57
mumpel
Beispiel:
Sub ReadLastMail()
    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("RMH Software").Folders("Gesendete Elemente")
     Set olMail = olFolder.Items.GetLast
     
     olMail.SaveAs "Test.msg", 3

End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Office 2002-2013 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:mumpel

Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0


Anzeige
AW: Anderes Email Postfach auswählen
05.09.2015 10:11:58
matthias
Danke für die Info.
Leider habe ich nicht so tiefe Kenntnisse in VBA.
Wie müsste ich den Bereich des Codes anpassen wo die Email gespeichert wird?

AW: Anderes Email Postfach auswählen
05.09.2015 10:20:58
mumpel
Ersetze die Codezeilen
Dim olApp As Object, objMail As Object

Set olApp = GetObject(, "OutLook.Application")
Set objMail = olApp.Session.GetDefaultFolder(5).Items.GetLast
    objMail.SaveAs FolderPDF & Format(Date, "yymmdd") & _
                   "_" & "B" & "_" & wksPrint.Range("A8").Text & _
                   "_" & wksPrint.Range("A9").Text & "_" & _
                   wksPrint.Range("U1").Text & ".msg", 3

VBA/HTML - CodeConverter für Office-Foren, AddIn für Office 2002-2013 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:mumpel

Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0


durch die Codezeilen
    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("RMH Software").Folders("Gesendete Elemente")
     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

VBA/HTML - CodeConverter für Office-Foren, AddIn für Office 2002-2013 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:mumpel

Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0


Anzeige
AW: Anderes Email Postfach auswählen
05.09.2015 10:26:53
matthias
Vielen Dank.
Funktioniert Super :)

AW: Anderes Email Postfach auswählen
05.09.2015 10:28:45
mumpel
Dann erledigt.

AW: Anderes Email Postfach auswählen
05.09.2015 10:56:22
matthias
Ein Thema hätte ich vllt. doch noch
Nachfolgend der funktionierende Code.
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 & "_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(2)
.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." & 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
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
Die Emails werden verschickt, dann wird 15 Sekunden gewartet, bis die Email aus den gesendeten Objekten abgespeichtert wird.
Ich musste die Zeit soweit hoch nehmen, da es oft vorkam, dass die Email noch nicht im Ordner gesendete Objekte war, aber er einfach die letzte Email abgespeichtert hat. Somit wurde die falsche Email archiviert.
Habt hier jemand dazu eine besser Lösung?

Anzeige
AW: Anderes Email Postfach auswählen
05.09.2015 11:49:46
mumpel
Das Speichern würde ich ohnehin in Outlook machen, nicht über Excel. In Outlook kannst Du z.B. über "Application_ItemSend" das Speichern anstoßen.

AW: Anderes Email Postfach auswählen
05.09.2015 14:22:45
mumpel
Schick mir mal eine Beispiel-PDF-Datei. Dann kann ich mal etwas ausprobieren.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige