Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Mail Ablage automatisieren

Frage Microsoft Outlook & Mail

Mitglied: matt1967

matt1967 (Level 1) - Jetzt verbinden

24.08.2009, aktualisiert 19:57 Uhr, 2548 Aufrufe, 1 Kommentar

Hallo zusammen,

ich komme mal net so richtig weiter wäre super wenn mir einer von Euch helfen könnte!

Ich möchte einen bestimmten Vorgang in Outlook automatisieren. Das ganze sieht wie folgt aus:

Ich bekomme täglich Notification E - Mails über gemeldete Störung wie z.B diese hier:

Subjekt: Kunde1 : E-IM091360246 (Priority 2) - Dispatched

Ich habe jetzt auf unserem Sharepoint Server folgende Ordner Struktur angelegt.

Prio1
-------Kunde1
-------Kunde2
-------Kunde3

Prio2
-------Kunde1
-------Kunde2
-------Kunde3

Was ich erreichen möchte ist das bei jedem neuen Mail Eingang der auf einen Subject wie oben beschrieben zutrifft die Mail im entsprechenden Ordner abgelegt wird.
Ich habe bereits ein Script mit dem eine manuelle Auswahl via Explorer Fenster möglich ist aber wie bekomme ich das hin dass:

1) Die Sortierung in die Verschiedenen Ordner entsprechend dem Subject der Mail richtig gesetzt werden?
2) Und wie bekomme ich Outlook dazu nach Empfang der Mail die richtige Mail automatisch auf den Sharepoint zu kopieren?

wäre super wenn mir einer helfen könnte

Gruß
Matthias
01.
Option Explicit 
02.
 
03.
'------------------------------------------------------------- 
04.
' Einstellungen 
05.
'------------------------------------------------------------- 
06.
'Email format: 
07.
' MSG , TXT = plain text 
08.
Private Const EXM_OPT_MAILFORMAT As String = "MSG" 
09.
'Datums Format für File Name 
10.
Private Const EXM_OPT_FILENAME_DATEFORMAT As String = "yyyy-mm-dd_hh-nn-ss" 
11.
'Aufbauen des Filenamen 
12.
Private Const EXM_OPT_FILENAME_BUILD As String = "<DATE>_<SUBJECT>" 
13.
'festen Verzeichnisnamen nutzen 
14.
Private Const EXM_OPT_USEBROWSER As Boolean = True 
15.
'festes Verzeichnis angeben 
16.
Private Const EXM_OPT_TARGETFOLDER As String = "Y:\" 
17.
'max. Anzahl der zu kopierenden Mails empfohlener Wert 10 max. 20 
18.
Private Const EXM_OPT_MAX_NO As Integer = 10 
19.
'Email subject Einstellungen 
20.
Private Const EXM_OPT_CLEANSUBJECT_REGEX As String = "RE:\s|Re:\s|AW:\s|FW:\s|WG:\s|SV:\s|Antwort:\s" 
21.
'------------------------------------------------------------- 
22.
 
23.
 
24.
 
25.
Private Const EXM_001 As String = "Die E-Mail wurde erfolgreich abgelegt." 
26.
Private Const EXM_002 As String = "Die E-Mail konnte nicht abgelegt werden, Grund:" 
27.
Private Const EXM_003 As String = "Ausgewählter Pfad:" 
28.
Private Const EXM_004 As String = "E-Mail(s) ausgewählt und erfolgreich abgelegt." 
29.
Private Const EXM_005 As String = "<FREE>" 
30.
Private Const EXM_006 As String = "<FREE>" 
31.
Private Const EXM_007 As String = "Script abgebrochen" 
32.
Private Const EXM_008 As String = "Fehler aufgetreten: Sie haben mehr als [LIMIT_SELECTED_ITEMS] E-Mails ausgewählt. Die Aktion wurde beendet." 
33.
Private Const EXM_009 As String = "Es wurde keine E-Mail ausgewählt." 
34.
Private Const EXM_010 As String = "Es ist ein Fehler aufgetreten: es war keine Email im Fokus, so dass die Ablage nicht erfolgen konnte." 
35.
Private Const EXM_011 As String = "Es ist ein Fehler aufgetreten:" 
36.
Private Const EXM_012 As String = "Die Aktion wurde beendet." 
37.
Private Const EXM_013 As String = "Ausgewähltes Outlook-Dokument ist keine E-Mail" 
38.
Private Const EXM_014 As String = "Datei existiert bereits" 
39.
Private Const EXM_015 As String = "<FREE>" 
40.
Private Const EXM_016 As String = "Bitte wählen Sie den Ordner zum Exportieren:" 
41.
Private Const EXM_017 As String = "Fehler beim Exportieren aufgetreten" 
42.
Private Const EXM_018 As String = "Export erfolgreich" 
43.
Private Const EXM_019 As String = "Bei [NO_OF_FAILURES] E-Mail(s) ist ein Fehler aufgetreten:" 
44.
Private Const EXM_020 As String = "[NO_OF_SELECTED_ITEMS] E-Mail(s) wurden ausgewählt und [NO_OF_SUCCESS_ITEMS] E-Mail(s) erfolgreich abgelegt." 
45.
'------------------------------------------------------------- 
46.
 
47.
 
48.
 
49.
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long 
50.
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long 
51.
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long 
52.
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) 
53.
Private Const BIF_RETURNONLYFSDIRS = 1 
54.
Private Const MAX_PATH = 260 
55.
Private Type BrowseInfo 
56.
 
57.
    hwndOwner As Long 
58.
    pIDLRoot As Long 
59.
    pszDisplayName As Long 
60.
    lpszTitle As Long 
61.
    ulFlags As Long 
62.
    lpfnCallback As Long 
63.
    lParam As Long 
64.
    iImage As Long 
65.
End Type 
66.
 
67.
Public Sub ExportEmailToDrive() 
68.
     
69.
    Const PROCNAME As String = "ExportEmailToDrive" 
70.
     
71.
    On Error GoTo ErrorHandler 
72.
     
73.
    Dim myExplorer As Outlook.Explorer 
74.
    Dim myfolder As Outlook.MAPIFolder 
75.
    Dim myItem As Object 
76.
    Dim olSelection As Selection 
77.
    Dim strBackupPath As String 
78.
    Dim intCountAll As Integer 
79.
    Dim intCountFailures As Integer 
80.
    Dim strStatusMsg As String 
81.
    Dim vSuccess As Variant 
82.
    Dim strTemp1 As String 
83.
    Dim strTemp2 As String 
84.
    Dim strErrorMsg As String 
85.
  
86.
    '------------------------------------- 
87.
    'Ziellaufwerk 
88.
    '------------------------------------- 
89.
    If (EXM_OPT_USEBROWSER = True) Then 
90.
        strBackupPath = GetFileDir 
91.
        If Left(strBackupPath, 15) = "ERROR_OCCURRED:" Then 
92.
            strErrorMsg = Mid(strBackupPath, 16, 9999) 
93.
            Error 5004 
94.
        End If 
95.
    Else 
96.
        strBackupPath = EXM_OPT_TARGETFOLDER 
97.
    End If 
98.
    If strBackupPath = "" Then GoTo ExitScript 
99.
    If (Not Right(strBackupPath, 1) = "\") Then strBackupPath = strBackupPath & "\" 
100.
     
101.
     
102.
  
103.
    '------------------------------------- 
104.
    'Ablauf um zu erkennen ob es sich um einen Ordner mit E-Mails oder eine einzelne zu kopierende handelt 
105.
    '------------------------------------- 
106.
 
107.
    Set myExplorer = Application.ActiveExplorer 
108.
    Set myfolder = myExplorer.CurrentFolder 
109.
    If myfolder Is Nothing Then Error 5001 
110.
    If Not myfolder.DefaultItemType = olMailItem Then GoTo ExitScript 
111.
     
112.
    'Abruch wenn mehr als die fest eingestellte Anzahl vom Mails kopiert werden 
113.
    If myExplorer.Selection.Count > EXM_OPT_MAX_NO Then Error 5002 
114.
       
115.
    'keine E-Mails ausgewählt 
116.
    If myExplorer.Selection.Count = 0 Then Error 5003 
117.
      
118.
    Set olSelection = myExplorer.Selection 
119.
    intCountAll = 0 
120.
    intCountFailures = 0 
121.
    For Each myItem In olSelection 
122.
        intCountAll = intCountAll + 1 
123.
        vSuccess = ProcessEmail(myItem, strBackupPath) 
124.
        If (Not vSuccess = True) Then 
125.
            Select Case intCountFailures 
126.
                Case 0: strStatusMsg = vSuccess 
127.
                Case 1: strStatusMsg = "1x " & strStatusMsg & Chr(10) & "1x " & vSuccess 
128.
                Case Else: strStatusMsg = strStatusMsg & Chr(10) & "1x " & vSuccess 
129.
            End Select 
130.
            intCountFailures = intCountFailures + 1 
131.
        End If 
132.
    Next 
133.
    If intCountFailures = 0 Then 
134.
        strStatusMsg = intCountAll & " " & EXM_004 
135.
    End If 
136.
 
137.
         
138.
    'Abschlussmeldungen 
139.
    If (intCountFailures = 0) Then  'keine Fehler 
140.
        MsgBox strStatusMsg & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 64, EXM_018 
141.
    ElseIf (intCountAll = 1) Then   'nur eine Mail ausgewählt aber es ist ein Fehler aufgetreten 
142.
        MsgBox EXM_002 & Chr(10) & vSuccess & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 48, EXM_017 
143.
    Else    'mehr als eine Mail ausgewählt aber es ist ein Fehler aufgetreten 
144.
        strTemp1 = Replace(EXM_020, "[NO_OF_SELECTED_ITEMS]", intCountAll) 
145.
        strTemp1 = Replace(strTemp1, "[NO_OF_SUCCESS_ITEMS]", intCountAll - intCountFailures) 
146.
        strTemp2 = Replace(EXM_019, "[NO_OF_FAILURES]", intCountFailures) 
147.
        MsgBox strTemp1 & Chr(10) & Chr(10) & strTemp2 & Chr(10) & Chr(10) & strStatusMsg _ 
148.
        & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 48, EXM_017 
149.
    End If 
150.
 
151.
 
152.
ExitScript: 
153.
    Exit Sub 
154.
ErrorHandler: 
155.
    Select Case Err.Number 
156.
    Case 5001:  'keine email 
157.
        MsgBox EXM_010, 64, EXM_007 
158.
    Case 5002: 
159.
        MsgBox Replace(EXM_008, "[LIMIT_SELECTED_ITEMS]", EXM_OPT_MAX_NO), 64, EXM_007 
160.
    Case 5003: 
161.
        MsgBox EXM_009, 64, EXM_007 
162.
    Case 5004: 
163.
        MsgBox EXM_011 & Chr(10) & Chr(10) & strErrorMsg, 48, EXM_007 
164.
    Case Else: 
165.
        MsgBox EXM_011 & Chr(10) & Chr(10) _ 
166.
        & Err & " - " & Error$ & Chr(10) & Chr(10) & EXM_012, 48, EXM_007 
167.
    End Select 
168.
    Resume ExitScript 
169.
End Sub 
170.
 
171.
Private Function ProcessEmail(myItem As Object, strBackupPath As String) As Variant 
172.
    'speichert die Mails unter dem angegebenen Pfad. 
173.
    'liefert wahr zurück, wenn erfolgreich, ansonsten falsch. 
174.
 
175.
    Const PROCNAME As String = "ProcessEmail" 
176.
 
177.
    On Error GoTo ErrorHandler 
178.
 
179.
    Dim myMailItem As MailItem 
180.
    Dim strDate As String 
181.
    Dim strSender As String 
182.
    Dim strReceiver As String 
183.
    Dim strSubject As String 
184.
    Dim strFinalFileName As String 
185.
    Dim strFullPath As String 
186.
    Dim vExtConst As Variant 
187.
    Dim vTemp As String 
188.
    Dim strErrorMsg As String 
189.
 
190.
    If TypeOf myItem Is MailItem Then 
191.
         Set myMailItem = myItem 
192.
    Else 
193.
        Error 1001 
194.
    End If 
195.
 
196.
     
197.
    strDate = Format(myMailItem.ReceivedTime, EXM_OPT_FILENAME_DATEFORMAT) 
198.
    strSender = myMailItem.SenderName 
199.
    strReceiver = myMailItem.To 
200.
    If InStr(strReceiver, ";") > 0 Then strReceiver = Left(strReceiver, InStr(strReceiver, ";") - 1) 
201.
    strSubject = myMailItem.Subject 
202.
    strFinalFileName = EXM_OPT_FILENAME_BUILD 
203.
    strFinalFileName = Replace(strFinalFileName, "<DATE>", strDate) 
204.
    strFinalFileName = Replace(strFinalFileName, "<SENDER>", strSender) 
205.
    strFinalFileName = Replace(strFinalFileName, "<RECEIVER>", strReceiver) 
206.
    strFinalFileName = Replace(strFinalFileName, "<SUBJECT>", strSubject) 
207.
    strFinalFileName = CleanString(strFinalFileName) 
208.
    If Left(strFinalFileName, 15) = "ERROR_OCCURRED:" Then 
209.
        strErrorMsg = Mid(strFinalFileName, 16, 9999) 
210.
        Error 1003 
211.
    End If 
212.
    strFinalFileName = IIf(Len(strFinalFileName) > 251, Left(strFinalFileName, 251), strFinalFileName) 
213.
    strFullPath = strBackupPath & strFinalFileName 
214.
     
215.
    'Speichern als msg oder text 
216.
    Select Case UCase(EXM_OPT_MAILFORMAT) 
217.
        Case "MSG": 
218.
            strFullPath = strFullPath & ".msg" 
219.
            vExtConst = olMSG 
220.
        Case Else: 
221.
            strFullPath = strFullPath & ".txt" 
222.
            vExtConst = olTXT 
223.
    End Select 
224.
    'existiert das File bereits 
225.
    If CreateObject("Scripting.FileSystemObject").FileExists(strFullPath) = True Then 
226.
        Error 1002 
227.
    End If 
228.
     
229.
    'Speichern 
230.
    myMailItem.SaveAs strFullPath, vExtConst 
231.
     
232.
    'liefert wahr zurück wenn erfolgreich 
233.
    ProcessEmail = True 
234.
 
235.
ExitScript: 
236.
    Exit Function 
237.
ErrorHandler: 
238.
    Select Case Err.Number 
239.
    Case 1001: 
240.
        ProcessEmail = EXM_013 
241.
    Case 1002: 
242.
        ProcessEmail = EXM_014 
243.
    Case 1003: 
244.
        ProcessEmail = strErrorMsg 
245.
    Case Else: 
246.
        ProcessEmail = "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")" 
247.
    End Select 
248.
    Resume ExitScript 
249.
End Function 
250.
 
251.
 
252.
Private Function CleanString(strData As String) As String 
253.
 
254.
    Const PROCNAME As String = "CleanString" 
255.
 
256.
    On Error GoTo ErrorHandler 
257.
 
258.
     
259.
    Dim objRegExp As Object 
260.
    Set objRegExp = CreateObject("VBScript.RegExp") 
261.
    objRegExp.Global = True 
262.
 
263.
     
264.
    objRegExp.Pattern = EXM_OPT_CLEANSUBJECT_REGEX 
265.
    strData = objRegExp.Replace(strData, "") 
266.
 
267.
     
268.
    strData = Replace(strData, Chr(9), "_") 
269.
    strData = Replace(strData, Chr(10), "_") 
270.
    strData = Replace(strData, Chr(13), "_") 
271.
    objRegExp.Pattern = "[/\\*]" 
272.
    strData = objRegExp.Replace(strData, "-") 
273.
    objRegExp.Pattern = "[""]" 
274.
    strData = objRegExp.Replace(strData, "'") 
275.
    objRegExp.Pattern = "[:?<>\|]" 
276.
    strData = objRegExp.Replace(strData, "") 
277.
     
278.
     
279.
    objRegExp.Pattern = "\s+" 
280.
    strData = objRegExp.Replace(strData, " ") 
281.
    objRegExp.Pattern = "_+" 
282.
    strData = objRegExp.Replace(strData, "_") 
283.
    objRegExp.Pattern = "-+" 
284.
    strData = objRegExp.Replace(strData, "-") 
285.
    objRegExp.Pattern = "'+" 
286.
    strData = objRegExp.Replace(strData, "'") 
287.
             
288.
     
289.
    strData = Trim(strData) 
290.
     
291.
     
292.
    CleanString = strData 
293.
   
294.
   
295.
ExitScript: 
296.
    Exit Function 
297.
ErrorHandler: 
298.
    CleanString = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")" 
299.
    Resume ExitScript 
300.
End Function 
301.
 
302.
Private Function GetFileDir() As String 
303.
     
304.
    Const PROCNAME As String = "GetFileDir" 
305.
 
306.
    On Error GoTo ErrorHandler 
307.
 
308.
    Dim ret As String 
309.
    Dim lpIDList As Long 
310.
    Dim sPath As String 
311.
    Dim udtBI As BrowseInfo 
312.
    Dim RdStrings() As String 
313.
    Dim nNewFiles As Long 
314.
 
315.
     
316.
    With udtBI 
317.
        .lpszTitle = lstrcat(EXM_016, "") 
318.
        .ulFlags = BIF_RETURNONLYFSDIRS 
319.
    End With 
320.
 
321.
    lpIDList = SHBrowseForFolder(udtBI) 
322.
    If lpIDList = 0 Then Exit Function 
323.
        
324.
     
325.
    sPath = String$(MAX_PATH, 0) 
326.
    SHGetPathFromIDList lpIDList, sPath 
327.
    CoTaskMemFree lpIDList 
328.
     
329.
     
330.
    If (InStr(sPath, Chr$(0)) > 0) Then sPath = Left$(sPath, InStr(sPath, Chr(0)) - 1) 
331.
 
332.
     
333.
    GetFileDir = sPath 
334.
 
335.
ExitScript: 
336.
    Exit Function 
337.
ErrorHandler: 
338.
    GetFileDir = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")" 
339.
    Resume ExitScript 
340.
End Function


[Edit Biber] Code-Tags nachgetragen. [/Edit]
Mitglied: TanjaAufDerInsel
20.02.2010 um 16:19 Uhr
Hallo Matthias,

ich nutze zur automatischen E-Mail Ablage den mailonizer PRO von softeule.

www.mailonizer.de

Unter den Lösungen findest Du vielleicht auch etwas für Dein Problem.

Gruß Tanja
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(1)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Outlook & Mail
Outlook Ablage - habt ihr eine Idee? (6)

Frage von MegaGiga zum Thema Outlook & Mail ...

E-Mail
gelöst Plesk 17 - E-Mail zurückgestellt in Warteschlange (7)

Frage von ZeldaFreak zum Thema E-Mail ...

E-Mail
gelöst Mail Spam fremde IP (10)

Frage von BerndP zum Thema E-Mail ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...