Hilfe: Email mit VB aus Outlook automatisch speichern

lima-city → Forum → Programmiersprachen → Basic

Autor dieses Themas

14:17, 28.8.2009

Hi,
ich habe eine „kleine“ Frage und zwar hab ich ein Skript in VB (Outlook), was eintreffende Emails automatisch auf ihren Absender überprüft und als txt-Datei in einen lokalen Ordner auf meinem PC speichert.
Das Skript liegt im VB-Editor von Outlook unter „ThisOutlookSession“. Wenn jetzt bspw. eine Email reinkommt von einem entsprechenden Absender, schreibt das Skript die Email MANCHMAL ordnungsgemäß in den vorgegebenen Ordner, ABER MANCHMAL AUCH NICHT, obwohl es absolut die GLEICHE Email vom gleichen Absender war.

Mal machts Outlook mal nicht! Hat das einen Grund? Weiß einfach nicht mehr weiter!
Hat vielleicht jemand eine Ahnung woran das liegen könnte?

Tausend Dank für Eure Hilfe!!!!!!!!!

Im nachfolgenden das VB-Skript:

' <DieseOutlookSitzung>
Option Explicit

Public Enum olSaveAsTypeEnum
  olSaveAsTxt = 0
  olSaveAsRTF = 1
  olSaveAsMsg = 3
End Enum


Private WithEvents Items As Outlook.Items


' Verzeichnis, in dem die Mails gespeichert werden
Private Const MAIL_PATH As String = "C:\............"


Private Sub Application_Startup()
MsgBox ("Der Email-Filter wurde erfolgreich aktiviert")


Set Items = _
      Outlook.Session.GetDefaultFolder(olFolderInbox).Items
      

  Dim Ns As Outlook.NameSpace

  Set Ns = Application.GetNamespace("MAPI")
  Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
End Sub




Private Sub SaveMailAsFile(oMail As Outlook.MailItem, eType As olSaveAsTypeEnum, sPath As String)
  Dim dtDate As Date
  Dim sName As String
  Dim aName As String
  Dim sFile As String
  Dim sExt As String

  Dim Anlagen As Attachments
  Dim Ziel As String
  Dim i As Integer
  Dim Suchwert1 As Integer
  Dim Suchwert2 As Integer



If oMail.SenderEmailAddress = "AbsenderEmail@hierhin.de" Then    'Email geändert

MsgBox ("Neue Emails wurden empfangen und erfolgreich gesichert")


  Select Case eType
    Case olSaveAsTxt: sExt = ".txt"
    Case olSaveAsMsg: sExt = ".txt"
    ' (Nur RTF-Mails können als RTF gespeichert werden.)
    Case olSaveAsRTF: sExt = ".rtf"
    Case Else: Exit Sub
  End Select

  ' Sicherstellen, dass der Dateiname keine unerlaubten
  ' Zeichen enthält.
  sName = oMail.Subject
  aName = oMail.SenderEmailAddress
  ReplaceCharsForFileName sName, "_"

  ' Dateinamen aus Betreff und Empfangsdatum der Mail
  ' zusammensetzen.
  dtDate = oMail.ReceivedTime
  sName = Format(dtDate, "dd" & "_" & "mm" & "_" & "yyyy", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "  -  hh" & "_" & "nn" & "_" & "ss", _
    vbUseSystemDayOfWeek, vbUseSystem) & " +++ " & sName & " +++ " & aName & sExt

' oMail.SaveAs sPath & sName, eType
oMail.SaveAs sPath & sName & ".txt", olTXT


End If

End Sub




Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
' Ersetzt in Dateinamen unerlaubte Zeichen
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

Diskutiere mit und stelle Fragen: Jetzt kostenlos anmelden!

lima-city: Gratis werbefreier Webspace für deine eigene Homepage
bandi999

bandi999 hat kostenlosen Webspace.
7:11, 30.8.2009
Hi

ein kurzer Blick in GOOGLE lenkte meine Aufmerksamkeit auf
http://www.vboffice.net/sample.html?mnu=2&pub=5&smp=7&cmd=showitem

Ich vermute mal forsch, du hast versucht den Code anzupassen und die Ähnlichkeiten sind nicht ganz zufällig.

Wie auch immer, wenn ich deinen Code sehe und den im genannten Link, dann fällt auf, dass du die Funktion
```
Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
    SaveMailAsFile Item, olSaveAsMsg, MAIL_PATH
  End If
End Sub
```
komplett weggelassen hast. Gerade damit wird aber dein Makro gestartet wenn du Mail erhältst. Sofern dein geposteter Code also vollständig ist, sollte imho gar keine Mail abgespeichert werden.
Also ergänze erst mal die Funktion im Makro.

Die Variable Items initialisierst du übrigens 2x, das scheint mir auch nicht unbedingt erforderlich ;).

Viel Spaß beim Coden
Manni

Autor dieses Themas

zocca

zocca hat kostenlosen Webspace.

17:51, 31.8.2009

Hallo bandi999,

du hast recht, diese Funktion hatte ich vergessen anzugeben, hatte sie aber bisher auch drin. Trotzdem wird das komplette Skript immer noch manchmal ausgeführt und manchmal NICHT.

Kann es vielleicht irgendwo ran liegen???

Danke nochmal vielmals!!

' <DieseOutlookSitzung>
Option Explicit

Public Enum olSaveAsTypeEnum
  olSaveAsTxt = 0
  olSaveAsRTF = 1
  olSaveAsMsg = 3
End Enum


Private WithEvents Items As Outlook.Items


' Verzeichnis, in dem die Mails gespeichert werden
Private Const MAIL_PATH As String = "C:\............"


Private Sub Application_Startup()
MsgBox ("Der Email-Filter wurde erfolgreich aktiviert")


Set Items = _
      Outlook.Session.GetDefaultFolder(olFolderInbox).Items
      

  Dim Ns As Outlook.NameSpace

  Set Ns = Application.GetNamespace("MAPI")
  Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
End Sub




Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
    SaveMailAsFile Item, olSaveAsMsg, MAIL_PATH
  End If
End Sub




Private Sub SaveMailAsFile(oMail As Outlook.MailItem, eType As olSaveAsTypeEnum, sPath As String)
  Dim dtDate As Date
  Dim sName As String
  Dim aName As String
  Dim sFile As String
  Dim sExt As String

  Dim Anlagen As Attachments
  Dim Ziel As String
  Dim i As Integer
  Dim Suchwert1 As Integer
  Dim Suchwert2 As Integer



If oMail.SenderEmailAddress = "AbsenderEmail@hierhin.de" Then    'Email geändert

MsgBox ("Neue Emails wurden empfangen und erfolgreich gesichert")


  Select Case eType
    Case olSaveAsTxt: sExt = ".txt"
    Case olSaveAsMsg: sExt = ".txt"
    ' (Nur RTF-Mails können als RTF gespeichert werden.)
    Case olSaveAsRTF: sExt = ".rtf"
    Case Else: Exit Sub
  End Select

  ' Sicherstellen, dass der Dateiname keine unerlaubten
  ' Zeichen enthält.
  sName = oMail.Subject
  aName = oMail.SenderEmailAddress
  ReplaceCharsForFileName sName, "_"

  ' Dateinamen aus Betreff und Empfangsdatum der Mail
  ' zusammensetzen.
  dtDate = oMail.ReceivedTime
  sName = Format(dtDate, "dd" & "_" & "mm" & "_" & "yyyy", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "  -  hh" & "_" & "nn" & "_" & "ss", _
    vbUseSystemDayOfWeek, vbUseSystem) & " +++ " & sName & " +++ " & aName & sExt

' oMail.SaveAs sPath & sName, eType
oMail.SaveAs sPath & sName & ".txt", olTXT


End If

End Sub




Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
' Ersetzt in Dateinamen unerlaubte Zeichen
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

bandi999

bandi999 hat kostenlosen Webspace.

19:56, 31.8.2009
Hi,

zur Fehlersuche würde ich mal in die Funktion Items_ItemAdd eine MsgBox einbauen, dann kannst du schon mal erkennen ob Outlook die Funktion beim Maileingang aufruft oder nicht. Am besten eine in die If Schleife und eine ausserhalb. Dann kann mal weiter sehen.

Gruß
Manni
Autor dieses Themas
zocca

zocca hat kostenlosen Webspace.

17:50, 2.9.2009
Hi,

das hab ich getan und dabei wird mir nun MANCHMAL die Box angezeigt und MANCHMAL wiederum nicht, obwohl die Aktion immer 1:1 die selbe ist.

Ahhhh!
bandi999

bandi999 hat kostenlosen Webspace.

21:09, 2.9.2009
Tja, jetzt wird es schwierig.
Ich habe es mal mit meinem Outlook 2002 versucht. Da scheint die ganze Sache zu funktionieren, bis auf den Fall, wenn gleichzeitig mehrere Mails vom Server abgeholt werden. Dann wird nur eine davon gespeichert, das allerdings immer :).

Wie testest du? Mit richtigem Posteingang oder indem du Mails in Ordner verschiebst?
Du sagst ja, dass bei dir exakt gleiche Vorgänge unterschiedliche Auswirkungen haben. Geht es nach Outlook Neustart immer erst einmal bzw. nachdem der Fehler aufgetreten ist, bleibt er dann oder funktioniert es plötzlich wieder?
Bekommst du eigentlich den Sicherheitshinweis von Ooutlook wenn das Makro auf den Postfachordner zugreift? Falls du Outlook älter als 2002 hast, evtl. updaten. Evlt. Outlook mal neu installieren.

Leider sind all meine Fragen keinen gezielter Weg um den Fehler zu lokalisieren, sondern eher Anregungen, evtl. doch noch eine Systematik zu entdecken und den Fehler weiter einzugrenzen oder zumindest eine zuverlässige Methode zu finden um den Fehler zu erzwingen.

Gruß
Manni
Autor dieses Themas
zocca

zocca hat kostenlosen Webspace.

21:58, 2.9.2009
Hallo Manni,

Vielen Dank das du mir hilfst

Ich weiß, es scheint irgendwie ein komischer Fehler zu sein, weil er wahrscheinlich irgendwie auf eine Laune in Outlook zurückzuführen ist. Vielleicht würde ein Update wirklich helfen. (Ich bezweifel es)

Ich muss mal evtl. versuchen die Regel aus der MeineOutlookSitzung rauszumachen und als Makro zu schreiben und mit ner Regel aufzurufen. Vielleicht würde das gehen, wobei ich das glaub ich auch schon mal probiert habe.

Ich habe leider auch nicht viele brauchbare Quellcode-Lösungen oder Software im Netz dazu gefunden.

Die Emails sollen auf jeden Fall in einen lokalen Ordner gespeichert werden. Bei mir geht es auch manchmal nicht, wenn ich nur schon EINE Email empfange.

Falls du doch noch über eine Lösung oder einem möglichen Ansatz stolpern solltest, würde ich mich sehr über deine Antwort freuen. Ich werde auch weiter probieren...

Bis hierhin aber schon mal Vielen Dank!

MfG
bandi999

bandi999 hat kostenlosen Webspace.

23:23, 2.9.2009
Tja dann,

eine Idee wäre noch die ensprechenden Mails über eine Regel in einen extra Ordner zu leiten und diesen mit deinem Script zu überwachen.
Eine andere Möglichkeit wäre die Post in einem bestimmten Zeitintervall in den lokalen Ordner zu exportieren.

Gruß und viel Glück
Manni
Autor dieses Themas
zocca

zocca hat kostenlosen Webspace.

7:51, 5.9.2009
Dank dir.

Kann man einen solchen zeitgesteurten Export denn irgendwie per VB schreiben?

MfG

bandi999

bandi999 hat kostenlosen Webspace.

0:15, 6.9.2009

Hi,

also in Anlehnung an das was du bereits hast und mit Hilfe von:
http://www.cpearson.com/excel/OnTime.aspx
habe ich es mal versucht.
Mein Outlook VBA bietet leider nicht die Funktion onTime, so dass ich auf die Variante mit dem Windows Timer zurückgreifen musste.
Zum Testen empfehle ich dir die Makro-Sicherheit auf Mittel zu stellen, damit du auch mal ohne Makro starten kannst ;).
Es werden im Zeitintervall von 1 Minute gnadenlos alles Mails im Posteingang als .txt geschrieben. Das kannst du natürlich noch filtern oder optimieren. Irgendwie habe ich auch bei der ganzen Konstruktion Magenschmerzen, aber ich weiß nichts besseres. Wenn eine Mail nach dem letzten Timerintervall und vor dem Schliessen von OL eingeht, dann wird sie natürlich nicht geschrieben.

Also unter "DieseOutlookSitzung" habe ich diesen Code:

Option Explicit

Private Sub Application_Startup()
  MsgBox ("Der Email-Filter wurde erfolgreich aktiviert")
  StartTimer
End Sub

Private Sub Application_Quit()
  EndTimer
End Sub

Und in einem Standardmodul (unter Module :)) steht dann dies:

Option Explicit
Public Items As Outlook.Items
Public oMail As Outlook.MailItem

Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long) As Long
    
Public Const sPath As String = "C:\post\"
Public TimerID As Long
Public TimerSeconds As Single

Sub StartTimer()
  TimerSeconds = 60  ' how often to "pop" the timer.
  TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
        ByVal nIDEvent As Long, ByVal dwTimer As Long)
   
  Set Items = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
  
  Dim dtDate As Date
  Dim sName As String
  Dim aName As String
  Dim sFile As String
  Dim sExt As String

  Dim Anlagen As Attachments
  Dim Ziel As String
  Dim i As Integer
  Dim Suchwert1 As Integer
  Dim Suchwert2 As Integer

  sExt = ".txt"
  
  For i = 1 To Items.Count
  If i = 1 Then
    Set oMail = Items.GetFirst
  Else
    Set oMail = Items.GetNext
  End If
  
  ' Sicherstellen, dass der Dateiname keine unerlaubten
  ' Zeichen enthält.
  sName = oMail.Subject
  'aName = oMail.SenderEmailAddress
  ReplaceCharsForFileName sName, "_"

  ' Dateinamen aus Betreff und Empfangsdatum der Mail
  ' zusammensetzen.
  dtDate = oMail.ReceivedTime
  sName = Format(dtDate, "dd" & "_" & "mm" & "_" & "yyyy", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "  -  hh" & "_" & "nn" & "_" & "ss", _
    vbUseSystemDayOfWeek, vbUseSystem) & " +++ " & sName & " +++ " & aName & sExt

' oMail.SaveAs sPath & sName, eType
oMail.SaveAs sPath & sName & ".txt", olTXT

Next i

MsgBox ("Emails wurden erfolgreich gesichert")

End Sub


Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
' Ersetzt in Dateinamen unerlaubte Zeichen
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

Gruß
Manni

vba-depp

vba-depp hat kostenlosen Webspace.

7:01, 10.12.2010
Hallo Leute !

Hab mich gerade im Netz auf die Suche gemacht, um ein Script zu finden, was genau das tut, was hier diskutiert wurde. Also bin ich frohen Mutes beigegangen, und habe im VBA den Code eingefügt. Leider mußte ich feststellen, daß ich überhaupt gar keine Ahnung von VBA habe und nicht mal das Script zu laufen bekomme.

Könnte Ihr auch einem völligen Dummbatz helfen? Ich müßte wissen, was ich genau mit dem Script tun muß, damit VBA es ausführt.

Bisher habe ich den Code einfach im rechten Fenster (das da heißt VBAProjekt - diese Sitzung CODE) eingefügt. Dann passiert eigentlich ganz viel gar nix. Dann dachte ich: Sei mal schlau und füge eine Prozedur ein. Das erzeugte neuen Code:

Public Sub getIn()

End Sub

Auch das anschließende Einfügen vom Code half nix.

Meine Frage ist nun: Wie muß ich den Code in VBA reintun, damit es anschließend auch ausgeführt wird?

1000 Dank im Voraus
VBA-Depp
Diskutiere mit und stelle Fragen: Jetzt kostenlos anmelden!

lima-city: Gratis werbefreier Webspace für deine eigene Homepage

Dir gefällt dieses Thema?

Über lima-city

lima-city bietet dir kostenlosen und werbefreien Speicherplatz für Deine Homepage. Sofort anmelden und direkt loslegen mit Webspace, PHP, Datenbanken, günstigen Domains und einer tollen Community!

kostenloser Webspace werbefrei: lima-city