Anderes Email Postfach auswählen

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

Betrifft: Anderes Email Postfach auswählen
von: matthias
Geschrieben am: 04.09.2015 18:52:59

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

Bild

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

Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: matthias
Geschrieben am: 04.09.2015 20:37:48
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?

Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: matthias
Geschrieben am: 04.09.2015 20:42:47
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?

Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: mumpel
Geschrieben am: 04.09.2015 22:31:25

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?

Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: matthias
Geschrieben am: 04.09.2015 22:56:05
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

Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: mumpel
Geschrieben am: 05.09.2015 10:04:57
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



Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: matthias
Geschrieben am: 05.09.2015 10:11:58
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?

Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: mumpel
Geschrieben am: 05.09.2015 10:20:58
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



Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: matthias
Geschrieben am: 05.09.2015 10:26:53
Vielen Dank.
Funktioniert Super :)

Bild

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

Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: matthias
Geschrieben am: 05.09.2015 10:56:22
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?

Bild

Betrifft: AW: Anderes Email Postfach auswählen
von: mumpel
Geschrieben am: 05.09.2015 11:49:46
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.

Bild

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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Anderes Email Postfach auswählen"