'========================================================================== 'Export Outlook e-mail to drive '-------------------------------------------------------------------------- 'Original von 'Author: Michael Wöhrer 'Version: 0.2, 2009-01-20 'umgeschrieben und erweitert von Hanners '========================================================================== 'Terms and conditions ' You can use, redistribute and/or modify this code under the terms of ' the SOFTWARE GUIDE LICENSE. This code is distributed in the hope that it ' will be useful, but WITHOUT ANY WARRANTY; without even the implied ' warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ' See the SOFTWARE GUIDE LICENSE for more details. '==========================================================================

Type OPENFILENAME lStructSize As Long hWndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustomFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFilextension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type

'------------------------------------- 'Process according to what is in the focus: an opened e-mail or a folder with selected e-mails. 'Case 2 would also work for opened e-mail, however it does not always work (for instance if ' an e-mail is saved on the file system and being opened from there). '-------------------------------------

Set myExplorer = Application.ActiveExplorer Set myfolder = myExplorer.CurrentFolder If myfolder Is Nothing Then Error 5001 If Not myfolder.DefaultItemType = olMailItem Then GoTo ExitScript

'Stop if more than x emails selected If myExplorer.Selection.Count > EXM_OPT_MAX_NO Then Error 5002

If objFolder Is Nothing Then MsgBox "Dieser Ordner existiert nicht!", vbOKOnly + vbExclamation, "Fehler" End If

If Application.ActiveExplorer.Selection.Count = 0 Then Exit Sub End If

For Each objItem In Application.ActiveExplorer.Selection objItem.UnRead = False 'Email in Outlook wird als gelesen markieren If objFolder.DefaultItemType = olMailItem Then If objItem.Class = olMail Then objItem.Move objFolder 'Datei wird verschoben End If End If Next

'========================================================================== 'Export Outlook e-mail to drive '-------------------------------------------------------------------------- 'Original von 'Author: Michael Wöhrer 'Version: 0.2, 2009-01-20 'umgeschrieben und erweitert von Hanners '========================================================================== 'Terms and conditions ' You can use, redistribute and/or modify this code under the terms of ' the SOFTWARE GUIDE LICENSE. This code is distributed in the hope that it ' will be useful, but WITHOUT ANY WARRANTY; without even the implied ' warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ' See the SOFTWARE GUIDE LICENSE for more details. '==========================================================================

Type OPENFILENAME lStructSize As Long hWndOwner As LongPtr hInstance As LongPtr lpstrFilter As String lpstrCustomFilter As String nMaxCustomFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFilextension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type

'------------------------------------- 'Process according to what is in the focus: an opened e-mail or a folder with selected e-mails. 'Case 2 would also work for opened e-mail, however it does not always work (for instance if ' an e-mail is saved on the file system and being opened from there). '-------------------------------------

Set myExplorer = Application.ActiveExplorer Set myfolder = myExplorer.CurrentFolder If myfolder Is Nothing Then Error 5001 If Not myfolder.DefaultItemType = olMailItem Then GoTo ExitScript

'Stop if more than x emails selected If myExplorer.Selection.Count > EXM_OPT_MAX_NO Then Error 5002

If objFolder Is Nothing Then MsgBox "Dieser Ordner existiert nicht!", vbOKOnly + vbExclamation, "Fehler" End If

If Application.ActiveExplorer.Selection.Count = 0 Then Exit Sub End If

For Each objItem In Application.ActiveExplorer.Selection objItem.UnRead = False 'Email in Outlook wird als gelesen markieren If objFolder.DefaultItemType = olMailItem Then If objItem.Class = olMail Then objItem.Move objFolder 'Datei wird verschoben End If End If Next

'========================================================================== 'Export Outlook e-mail to drive '-------------------------------------------------------------------------- 'Original von 'Author: Michael Wöhrer 'Version: 0.2, 2009-01-20 'umgeschrieben und erweitert von Hanners '========================================================================== 'Terms and conditions ' You can use, redistribute and/or modify this code under the terms of ' the SOFTWARE GUIDE LICENSE. This code is distributed in the hope that it ' will be useful, but WITHOUT ANY WARRANTY; without even the implied ' warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ' See the SOFTWARE GUIDE LICENSE for more details. '==========================================================================

Type OPENFILENAME lStructSize As Long hWndOwner As LongPtr hInstance As LongPtr lpstrFilter As String lpstrCustomFilter As String nMaxCustomFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFilextension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type

'------------------------------------- 'Process according to what is in the focus: an opened e-mail or a folder with selected e-mails. 'Case 2 would also work for opened e-mail, however it does not always work (for instance if ' an e-mail is saved on the file system and being opened from there). '-------------------------------------

Set myExplorer = Application.ActiveExplorer Set myfolder = myExplorer.CurrentFolder If myfolder Is Nothing Then Error 5001 If Not myfolder.DefaultItemType = olMailItem Then GoTo ExitScript

'Stop if more than x emails selected If myExplorer.Selection.Count > EXM_OPT_MAX_NO Then Error 5002

If objFolder Is Nothing Then MsgBox "Dieser Ordner existiert nicht!", vbOKOnly + vbExclamation, "Fehler" End If

If Application.ActiveExplorer.Selection.Count = 0 Then Exit Sub End If

For Each objItem In Application.ActiveExplorer.Selection objItem.UnRead = False 'Email in Outlook wird als gelesen markieren If objFolder.DefaultItemType = olMailItem Then If objItem.Class = olMail Then objItem.Move objFolder 'Datei wird verschoben End If End If Next

'========================================================================== 'Export Outlook e-mail to drive '-------------------------------------------------------------------------- 'Original von 'Author: Michael Wöhrer 'Version: 0.2, 2009-01-20 'umgeschrieben und erweitert von Hanners '========================================================================== 'Terms and conditions ' You can use, redistribute and/or modify this code under the terms of ' the SOFTWARE GUIDE LICENSE. This code is distributed in the hope that it ' will be useful, but WITHOUT ANY WARRANTY; without even the implied ' warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ' See the SOFTWARE GUIDE LICENSE for more details. '==========================================================================

Type OPENFILENAME lStructSize As Long hWndOwner As LongPtr hInstance As LongPtr lpstrFilter As String lpstrCustomFilter As String nMaxCustomFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFilextension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type

'------------------------------------- 'Process according to what is in the focus: an opened e-mail or a folder with selected e-mails. 'Case 2 would also work for opened e-mail, however it does not always work (for instance if ' an e-mail is saved on the file system and being opened from there). '-------------------------------------

Set myExplorer = Application.ActiveExplorer Set myfolder = myExplorer.CurrentFolder If myfolder Is Nothing Then Error 5001 If Not myfolder.DefaultItemType = olMailItem Then GoTo ExitScript

'Stop if more than x emails selected If myExplorer.Selection.Count > EXM_OPT_MAX_NO Then Error 5002

If objFolder Is Nothing Then MsgBox "Dieser Ordner existiert nicht!", vbOKOnly + vbExclamation, "Fehler" End If

If Application.ActiveExplorer.Selection.Count = 0 Then Exit Sub End If

For Each objItem In Application.ActiveExplorer.Selection objItem.UnRead = False 'Email in Outlook wird als gelesen markieren If objFolder.DefaultItemType = olMailItem Then If objItem.Class = olMail Then objItem.Move objFolder 'Datei wird verschoben End If End If Next