Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Outlook-Script zum Speichern einer Mail
Gehe zu Seite Zurück  1, 2, 3, 4, 5, 6, 7, 8, 9  Weiter
zurück: Signatur per Makro bearbeiten weiter: Warnfenster falls Betreff schon im Postfach vorhanden ? Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Antwort Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
mex_
Im Profil kannst Du frei den Rang ändern


Verfasst am:
02. März 2010, 18:05
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Hat keine eine Idee wie die Fenstergröße größer dargestellt werden kann?
grossermanitu
Im Profil kannst Du frei den Rang ändern


Verfasst am:
26. März 2010, 11:20
Rufname:


AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Hallo nach langem suchen bin ich auf dieses Script gestoßen. Es funzt bei mir wunderbar. Wenn mir jemand noch zeigen könnte wie ich alle Emails aus einem festdefinierten Ordner
Code:
 objNS.Folders("Postfach -  Sourcing").Folders("Posteingang").Folders("2010")
ohne Auswahl speichern kann wäre ich total begeistert. Anbei mein derzeit verwendetet Code und ich wünsche ein schönes Wochenende

Code:
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260

Public Type BrowseInfo
    hwndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type


Sub SpeichernalsMSG()

Dim myExplorer As Outlook.Explorer
Dim myFolder As Outlook.MAPIFolder
Dim strname As String
Dim myItem As MailItem
Dim olSelection As Selection
Dim strBackupPath As String
Dim lngAttCount As Long, i As Long


Set myExplorer = Application.ActiveExplorer
Set myFolder = myExplorer.CurrentFolder

If Not myFolder.DefaultItemType = olMailItem Then GoTo Ende

'Pfad auswählen
'strBackupPath = GetFileDir
'Pfad eintragen
strBackupPath = "C:\WINDOWS\Profiles\eh2roo2\Desktop\Neuer Ordner"


Set olSelection = myExplorer.Selection


For Each myItem In olSelection

strname = IIf(Len(strBackupPath & myItem.Subject) > 255, _
Left(myItem.Subject, 255 - Len(strBackupPath)), myItem.Subject) & ".MSG"


myItem.SaveAs strBackupPath & "\" & CleanString(strname), olMSG    '=> GIBT FEHLER AUS !!!
 

Next
Ende:

End Sub

Private Function CleanString(strData As String) As String
strData = ReplaceChar(strData, "´", "_")
strData = ReplaceChar(strData, "`", "_")
strData = ReplaceChar(strData, "'", "_")
strData = ReplaceChar(strData, "{", "(")
strData = ReplaceChar(strData, "[", "(")
strData = ReplaceChar(strData, "]", ")")
strData = ReplaceChar(strData, "}", ")")
strData = ReplaceChar(strData, "/", "-")
strData = ReplaceChar(strData, "\", "-")
strData = ReplaceChar(strData, ":", "")
strData = ReplaceChar(strData, "*", "_")
strData = ReplaceChar(strData, "?", "")
strData = ReplaceChar(strData, """", "_")
strData = ReplaceChar(strData, "|", "")
strData = ReplaceChar(strData, "<", "")
strData = ReplaceChar(strData, ">", "")
strData = ReplaceChar(strData, " ", "_")
CleanString = Trim(strData)
End Function

Private Function ReplaceChar(strData As String, strBadChar As String, strGoodChar As String) As String
Dim tmpChar, tmpString As String
Dim i As Long
For i = 1 To Len(strData)
tmpChar = Mid(strData, i, 1)
If tmpChar = strBadChar Then
tmpString = tmpString & strGoodChar
Else
tmpString = tmpString & tmpChar
End If
Next i
ReplaceChar = Trim(tmpString)
End Function

Public Function GetFileDir() As String
Dim ret As String
    Dim lpIDList As Long
    Dim sPath As String, udtBI As BrowseInfo
    Dim RdStrings() As String, nNewFiles As Long

    'Show a browse-for-folder form:
    With udtBI
        .lpszTitle = lstrcat("Bitte wählen Sie den Ordner zum Exportieren:", "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList = 0 Then Exit Function
       
    'Get the selected folder.
    sPath = String$(MAX_PATH, 0)
    SHGetPathFromIDList lpIDList, sPath
    CoTaskMemFree lpIDList
    sPath = StripNulls(sPath)
    GetFileDir = sPath
End Function

Public Function StripNulls(ByVal OriginalStr As String) As String
    If (InStr(OriginalStr, Chr$(0)) > 0) Then
        OriginalStr = Left$(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function

Public Function FileExists(PrüfnameMsg, SubDir As String)

On Error Resume Next
'Datei schon gespeichert
      changes = False
      Number = 1
      prüfname = PrüfnameMsg
Back:

      Number = Number + 1

       If CreateObject("Scripting.FileSystemObject").FileExists(prüfname) = True Then
        dateiname = CreateObject("Scripting.FileSystemObject").GetBaseName(prüfname)
        dateiendung = CreateObject("Scripting.FileSystemObject").GetExtensionName(prüfname)
        dateinameneu = dateiname & " (" & Number & ")" & "." & dateiendung
        prüfname = SubDir & "\" & dateinameneu
        changes = True
        GoTo Back:
       Else
       End If

        If changes = False Then
         FileExists = PrüfnameMsg
        Else
         FileExists = prüfname
        End If

End Function


Beglückter!
Gast


Verfasst am:
12. Apr 2010, 10:42
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       Version: Office 2003

Vielen herzlichen Dank für den genialen Code den Du hier an meinem 39sten Geburtstag publiziert hast und der mir heute, knapp 4 Jahre später sehr geholfen hat.

Mfg
Gast



Verfasst am:
05. Aug 2010, 18:41
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Herzlichen Dank für dieses wunderbare Makro. Es hilft mir schon sehr weiter. Wäre es vielleicht möglich, dass a) das Fenster für den Speicherort sich den letzten Speicherort merkt, oder sogar b) eine Email per darg & drop in ein Explorerfenster ziehen kann?
Gast



Verfasst am:
23. Aug 2010, 11:31
Rufname:


AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Der Threat ist zwar schon etwas älter aber ich hätte hier noch eine Idee für Script.

Gibt es eine Möglichkeit dass die Mails ohne Anhang ganz normall im TXT (oder HTM)-format abgespeichert werden, und sobals ein Anhang dabei ist, dieser mit dem Mail in ein ZIP-File gepackt wird?
Gast



Verfasst am:
23. Aug 2010, 11:33
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Der Threat ist zwar schon etwas älter aber ich hätte hier noch eine Idee für Script.

Gibt es eine Möglichkeit dass die Mails ohne Anhang ganz normall im TXT (oder HTM)-format abgespeichert werden, und sobals ein Anhang dabei ist, dieser mit dem Mail in ein ZIP-File gepackt wird?
ge.ni
Neuling


Verfasst am:
30. Nov 2010, 15:08
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Bin auf der suche die Ablage von emails zu automatisieren und bin über diesen super interessante Thema gestolpert.

Erst mal Vielen Dank für alle die guten Ideen hier.
('Wink')

Vieles hat mir geholfen einige Sachen habe ich schon geschaft anzupassen jedoch bleiben auch noch Fragen offen.


Zunächst meine Idee ich bekomme eine Mail und möchte diese in einem "Vorgangsordner" ablegen innerhalb des Ordners gibt es immer einen Ordner "email" und einen Ordner "Dokumente".
Alle Emails kommen als msg in den Ordner Email alle Anlagen in den Ordner "Dokumente".
soweit so gut klappt auch alles perfekt.

('Sad') Jetzt kommt mein Problem ich würde gerne eine Dokumentenliste führen (xls) in die nun die Emails und Anlagen mit Eingangsdatum und hyperlink eingetragen werden. wer kann mir hier helfen oder einen Tipp geben wie es klappen könnte.
ge.ni
Neuling


Verfasst am:
30. Nov 2010, 15:18
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Dann habe ich noch einige Fragen zu dem hier geposteten Script


1. Frage was passiert hier? - brauche ich das?
Code:
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260

Public Type BrowseInfo
    hwndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type


2. Hier frage ich den Speicherpfad ab:
Code:
MsgBox "Vorgangsordner auswählen"
Set myExplorer = Application.ActiveExplorer
Set myfolder = myExplorer.CurrentFolder
If Not myfolder.DefaultItemType = olMailItem Then GoTo Ende
vorgangsordner = GetFileDir
If vorgangsordner = "" Then Exit Sub
Set olSelection = myExplorer.Selection

emailordner = vorgangsordner & "\" & "emails"
Dokumentenordner = vorgangsordner & "\" & "Herstellerdokumente"

Code:
Public Function GetFileDir() As String
'Funktion zum Auswählen des Speicherpfades

Dim ret As String
    Dim lpIDList As Long
    Dim sPath As String, udtBI As BrowseInfo
    Dim RdStrings() As String, nNewFiles As Long

'zeigt das Ordnerwahlfenster:
    With udtBI
        .lpszTitle = lstrcat("Bitte Speicherpfad auswählen:", "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList = 0 Then Exit Function
       
'Liest den Pfad ein.
    sPath = String$(MAX_PATH, 0)
    SHGetPathFromIDList lpIDList, sPath
    CoTaskMemFree lpIDList
    sPath = StripNulls(sPath)
    GetFileDir = sPath
End Function


Kann man einen Startpfad vorgeben? oder gibt es eine einfachere Alternative.

Und zuletzt wofür sind diese beiden Funktionen?
Code:
Private Function ReplaceChar(strData As String, strBadChar As String, strGoodChar As String) As String
Dim tmpChar, tmpString As String
Dim i As Long
For i = 1 To Len(strData)
tmpChar = Mid(strData, i, 1)
If tmpChar = strBadChar Then
tmpString = tmpString & strGoodChar
Else
tmpString = tmpString & tmpChar
End If
Next i
ReplaceChar = Trim(tmpString)
End Function
Public Function StripNulls(ByVal OriginalStr As String) As String
    If (InStr(OriginalStr, Chr$(0)) > 0) Then
        OriginalStr = Left$(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function


Ich hoffe es kann mir jemand helfen bzw meiner Unkenntnis auf die Sprünge helfen.
Gast



Verfasst am:
05. Jan 2011, 14:10
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       Version: Office 2003

Hallo zusammen,

auch ich möchte diesen schon relativ alten aber "genialen!!" Post aufgreifen und könnte falls möglich Unterstützung gebrauchen da meine VB Kenntnisse doch sehr beschränkt sind. Im Prinzip wurden diese Fragen auch zum Teil bereits gestellt aber noch nicht beantwortet.

Frage 1:

myItem.FlagStatus = olFlagComplete

Soll die bereits abgelegen Mails als "erledigt (Hacken) markieren. Wo muss diese Zeile hin? Doch eigentlich in eine Zeile die den Ursprung, sprich die ausgewählten Mails betrifft. Ich habe schon diverse versucht bekomme es aber leider nicht hin.

Frage 2:
Wie kann ich die Größe des "Ordner suchen" Fenster ändern bzw. wie ein normales Fenster "ziehen" und letzte Größe/Position speichern.

Frage 3:
Ist es möglich im Fenster "Ordner suchen" mit dem zuletzt benutzen Ordner wieder anzufangen oder zumindest einen festen Startpfad zu definieren. Da ja sonst immer im komplett minimierten Baum begonnen wird.
Hiermit müsste das doch irgendwie machbar sein (http://www.vbarchiv.net/tipps/details.php?id=1089)

Frage 4:
Mit dem aktuellen Skript werden ja Mails markiert und dann in einem Ordner mit entsprechendem Dateinamen als msg oder txt gespeichert.

Aber: Ist es möglich das man das ganze bereits eine Ebene höher auswählen kann:
Ordner ->Posteingang
->Familie
->Sender1
-> Emails
->Sender2
-> Emails
Sprich den Ordner Familie auswählen -> Skript starten -> Ordner auf Festplatte wählen -> Speichern der Mails wie gewohnt nur mit der gesamten Ordnerstruktur (inkl. Anlegen noch nicht vorhandener Unterordner).

Ich hoffe hier nicht gegen irgendwelche Lizenzen zu verstoßen, der von mir benutze Skript:

Code:
Option Explicit

'-------------------------------------------------------------
' OPTIONS
'-------------------------------------------------------------
'Email format:
' MSG = Outlook msg format (incl. attachments, embedded objects etc.)., TXT = plain text
Private Const EXM_OPT_MAILFORMAT As String = "MSG"
'Date format of filename
Private Const EXM_OPT_FILENAME_DATEFORMAT As String = "yyyymmdd_hh_mm_ss"
'Build filename; placeholders: <DATE> for date, <SENDER> for sender's name, <RECEIVER> for receiver, <SUBJECT> for subject
Private Const EXM_OPT_FILENAME_BUILD As String = "<DATE>_<SUBJECT>_<SENDER>_<INDEX>"
'Use browse folder? Set to FALSE if you don't want to use browser for selecting target folder
Private Const EXM_OPT_USEBROWSER As Boolean = True
'Target folder (used if EXM_OPT_USEBROWSER is set to FALSE)
Private Const EXM_OPT_TARGETFOLDER As String = "S:\Projekte"
'Maximum number of emails to be selected & exported. Please don't use a huge number as this will cause
'performance and maybe other issues. Recommended is a value between 5 and 20.
Private Const EXM_OPT_MAX_NO As Integer = 500
'Email subject prefixes (such us "RE:", "FW:" etc.) to be removed. Please note that this is a
'RegEx expression, google for "regex" for further information. For instance "\s" means blank " ".
Private Const EXM_OPT_CLEANSUBJECT_REGEX As String = "RE:\s|Re:\s|AW:\s|FW:\s|WG:\s|SV:\s|Antwort:\s"
'-------------------------------------------------------------


'-------------------------------------------------------------
' TRANSLATIONS
'-------------------------------------------------------------
'-- English
'Const EXM_007 = "Script terminated"
'Const EXM_013 = "Selected Outlook item is not an e-mail"
'Const EXM_014 = "File already exists"
'-- German
Private Const EXM_001 As String = "Die E-Mail wurde erfolgreich abgelegt."
Private Const EXM_002 As String = "Die E-Mail konnte nicht abgelegt werden, Grund:"
Private Const EXM_003 As String = "Ausgewählter Pfad:"
Private Const EXM_004 As String = "E-Mail(s) ausgewählt und erfolgreich abgelegt."
Private Const EXM_005 As String = "<FREE>"
Private Const EXM_006 As String = "<FREE>"
Private Const EXM_007 As String = "Script abgebrochen"
Private Const EXM_008 As String = "Fehler aufgetreten: Sie haben mehr als [LIMIT_SELECTED_ITEMS] E-Mails ausgewählt. Die Aktion wurde beendet."
Private Const EXM_009 As String = "Es wurde keine E-Mail ausgewählt."
Private Const EXM_010 As String = "Es ist ein Fehler aufgetreten: es war keine Email im Fokus, so dass die Ablage nicht erfolgen konnte."
Private Const EXM_011 As String = "Es ist ein Fehler aufgetreten:"
Private Const EXM_012 As String = "Die Aktion wurde beendet."
Private Const EXM_013 As String = "Ausgewähltes Outlook-Dokument ist keine E-Mail"
Private Const EXM_014 As String = "Datei existiert bereits"
Private Const EXM_015 As String = "<FREE>"
Private Const EXM_016 As String = "Bitte wählen Sie den Ordner zum Exportieren:"
Private Const EXM_017 As String = "Fehler beim Exportieren aufgetreten"
Private Const EXM_018 As String = "Export erfolgreich"
Private Const EXM_019 As String = "Bei [NO_OF_FAILURES] E-Mail(s) ist ein Fehler aufgetreten:"
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."
'-------------------------------------------------------------


'-------------------------------------
'For browse folder
'-------------------------------------
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Private Type BrowseInfo

    hwndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

Public Sub ExportEmailToDrive()
   
    Const PROCNAME As String = "ExportEmailToDrive"
   
    On Error GoTo ErrorHandler
   
    Dim myExplorer As Outlook.Explorer
    Dim myfolder As Outlook.MAPIFolder
    Dim myItem As Object
    Dim olSelection As Selection
    Dim strBackupPath As String
    Dim intCountAll As Integer
    Dim intCountFailures As Integer
    Dim strStatusMsg As String
    Dim vSuccess As Variant
    Dim strTemp1 As String
    Dim strTemp2 As String
    Dim strErrorMsg As String
 
    '-------------------------------------
    'Get target drive
    '-------------------------------------
    If (EXM_OPT_USEBROWSER = True) Then
        strBackupPath = GetFileDir
        If Left(strBackupPath, 15) = "ERROR_OCCURRED:" Then
            strErrorMsg = Mid(strBackupPath, 16, 9999)
            Error 5004
        End If
    Else
        strBackupPath = EXM_OPT_TARGETFOLDER
    End If
    If strBackupPath = "" Then GoTo ExitScript
    If (Not Right(strBackupPath, 1) = "\") Then strBackupPath = strBackupPath & "\"
   
   
 
    '-------------------------------------
    '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
     
    'No email selected at all?
    If myExplorer.Selection.Count = 0 Then Error 5003
     
    Set olSelection = myExplorer.Selection
    intCountAll = 0
    intCountFailures = 0
    For Each myItem In olSelection
        intCountAll = intCountAll + 1
        vSuccess = ProcessEmail(myItem, strBackupPath)
       
               If (Not vSuccess = True) Then
            Select Case intCountFailures
                Case 0: strStatusMsg = vSuccess
                Case 1: strStatusMsg = "1x " & strStatusMsg & Chr(10) & "1x " & vSuccess
                Case Else: strStatusMsg = strStatusMsg & Chr(10) & "1x " & vSuccess
            End Select
            intCountFailures = intCountFailures + 1
        End If
    Next
    If intCountFailures = 0 Then
        strStatusMsg = intCountAll & " " & EXM_004
    End If

       
    'Final Message
    If (intCountFailures = 0) Then  'No failure occurred
        MsgBox strStatusMsg & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 64, EXM_018
    ElseIf (intCountAll = 1) Then   'Only one email was selected and a failure occurred
        MsgBox EXM_002 & Chr(10) & vSuccess & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 48, EXM_017
    Else    'More than one email was selected and at least one failure occurred
        strTemp1 = Replace(EXM_020, "[NO_OF_SELECTED_ITEMS]", intCountAll)
        strTemp1 = Replace(strTemp1, "[NO_OF_SUCCESS_ITEMS]", intCountAll - intCountFailures)
        strTemp2 = Replace(EXM_019, "[NO_OF_FAILURES]", intCountFailures)
        MsgBox strTemp1 & Chr(10) & Chr(10) & strTemp2 & Chr(10) & Chr(10) & strStatusMsg _
        & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 48, EXM_017
    End If


ExitScript:
    Exit Sub
ErrorHandler:
    Select Case Err.Number
    Case 5001:  'Not an email
        MsgBox EXM_010, 64, EXM_007
    Case 5002:
        MsgBox Replace(EXM_008, "[LIMIT_SELECTED_ITEMS]", EXM_OPT_MAX_NO), 64, EXM_007
    Case 5003:
        MsgBox EXM_009, 64, EXM_007
    Case 5004:
        MsgBox EXM_011 & Chr(10) & Chr(10) & strErrorMsg, 48, EXM_007
    Case Else:
        MsgBox EXM_011 & Chr(10) & Chr(10) _
        & Err & " - " & Error$ & Chr(10) & Chr(10) & EXM_012, 48, EXM_007
    End Select
    Resume ExitScript
End Sub

Private Function ProcessEmail(myItem As Object, strBackupPath As String) As Variant
    'Saves the e-mail on the drive by using the provided path.
    'Returns TRUE if successful, and FALSE otherwise.

    Const PROCNAME As String = "ProcessEmail"

    On Error GoTo ErrorHandler

    Dim myMailItem As MailItem
    Dim strDate As String
    Dim strSender As String
    Dim strReceiver As String
    Dim strSubject As String
    Dim strFinalFileName As String
    Dim strFullPath As String
    Dim vExtConst As Variant
    Dim vTemp As String
    Dim strErrorMsg As String
    Dim intIndex As Integer
    Dim strIndex As String
   

    If TypeOf myItem Is MailItem Then
         Set myMailItem = myItem
         
    Else
        Error 1001
    End If

   

    'Set filename
    strDate = Format(myMailItem.ReceivedTime, EXM_OPT_FILENAME_DATEFORMAT)
    strSender = myMailItem.SenderName
    strReceiver = myMailItem.To 'All receiver, semikolon separated string
    If InStr(strReceiver, ";") > 0 Then strReceiver = Left(strReceiver, InStr(strReceiver, ";") - 1)
   
   
   
    strIndex = CStr(intIndex)
   
    strSubject = myMailItem.Subject
    strFinalFileName = EXM_OPT_FILENAME_BUILD
    strFinalFileName = Replace(strFinalFileName, "<DATE>", strDate)
    strFinalFileName = Replace(strFinalFileName, "<SENDER>", strSender)
    strFinalFileName = Replace(strFinalFileName, "<RECEIVER>", strReceiver)
    strFinalFileName = Replace(strFinalFileName, "<SUBJECT>", strSubject)
    strFinalFileName = Replace(strFinalFileName, "<INDEX>", strIndex)
   
    strFinalFileName = CleanString(strFinalFileName)
    If Left(strFinalFileName, 15) = "ERROR_OCCURRED:" Then
        strErrorMsg = Mid(strFinalFileName, 16, 9999)
        Error 1003
    End If
    strFinalFileName = IIf(Len(strFinalFileName) > 251, Left(strFinalFileName, 251), strFinalFileName)
    strFullPath = strBackupPath & strFinalFileName
   
    'Save as msg or txt?
    Select Case UCase(EXM_OPT_MAILFORMAT)
        Case "MSG":
            strFullPath = strFullPath & ".msg"
            vExtConst = olMSG
        Case Else:
            strFullPath = strFullPath & ".txt"
            vExtConst = olTXT
    End Select
   
   
    'File already exists?
    If CreateObject("Scripting.FileSystemObject").FileExists(strFullPath) = True Then
        strIndex = strIndex + 1
    End If
   
    'Save file
    myMailItem.SaveAs strFullPath, vExtConst
 
   
    'Return true as everything was successful
    ProcessEmail = True

ExitScript:
    Exit Function
ErrorHandler:
    Select Case Err.Number
    Case 1001:  'Not an email
        ProcessEmail = EXM_013
    Case 1002:
        ProcessEmail = EXM_014
    Case 1003:
        ProcessEmail = strErrorMsg
    Case Else:
        ProcessEmail = "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
    End Select
    Resume ExitScript
End Function


Private Function CleanString(strData As String) As String

    Const PROCNAME As String = "CleanString"

    On Error GoTo ErrorHandler

    'Instantiate RegEx
    Dim objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True

    'Cut out strings we don't like
    objRegExp.Pattern = EXM_OPT_CLEANSUBJECT_REGEX
    strData = objRegExp.Replace(strData, "")

    'Replace and cut out invalid strings.
    strData = Replace(strData, Chr(9), "_")
    strData = Replace(strData, Chr(10), "_")
    strData = Replace(strData, Chr(13), "_")
    objRegExp.Pattern = "[/\\*]"
    strData = objRegExp.Replace(strData, "-")
    objRegExp.Pattern = "[""]"
    strData = objRegExp.Replace(strData, "'")
    objRegExp.Pattern = "[:?<>\|]"
    strData = objRegExp.Replace(strData, "")
   
    'Replace multiple chars by 1 char
    objRegExp.Pattern = "\s+"
    strData = objRegExp.Replace(strData, " ")
    objRegExp.Pattern = "_+"
    strData = objRegExp.Replace(strData, "_")
    objRegExp.Pattern = "-+"
    strData = objRegExp.Replace(strData, "-")
    objRegExp.Pattern = "'+"
    strData = objRegExp.Replace(strData, "'")
           
    'Trim
    strData = Trim(strData)
   
    'Return result
    CleanString = strData
 
 
ExitScript:
    Exit Function
ErrorHandler:
    CleanString = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
    Resume ExitScript
End Function

Private Function GetFileDir() As String
   
    Const PROCNAME As String = "GetFileDir"

    On Error GoTo ErrorHandler

    Dim ret As String
    Dim lpIDList As Long
    Dim sPath As String
    Dim udtBI As BrowseInfo
    Dim RdStrings() As String
    Dim nNewFiles As Long

    'Show a browse-for-folder form:
    With udtBI
        .lpszTitle = lstrcat(EXM_016, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList = 0 Then Exit Function
       
    'Get the selected folder.
    sPath = String$(MAX_PATH, 0)
    SHGetPathFromIDList lpIDList, sPath
    CoTaskMemFree lpIDList
   
    'Strip Nulls
    If (InStr(sPath, Chr$(0)) > 0) Then sPath = Left$(sPath, InStr(sPath, Chr(0)) - 1)

    'Return Dir
    GetFileDir = sPath

ExitScript:
    Exit Function
ErrorHandler:
    GetFileDir = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
    Resume ExitScript
End Function


Ich hoffe mir kann zumindest bei 1-3 jemand helfen.

1000 Danke schon mal im Voraus!!!!
BFE
Neuling


Verfasst am:
29. Jan 2011, 13:00
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Ich verwende auch dieses wunderbare Tool.

An einem neuem Rechner mit W7 mit Outlook 2003 bekomme ich jetzt folgende Fehlermeldung:

Die E-Mail konnte nicht abgelegt werden, Grund:
Error #432: Datei- oder Klassenname während Automatisierungsoperation nichjt gefunden(Procedure CleanString)

Da ich keine Ahnung von VBA habe, weiß ich im Moment nicht was zu tun ist.

Wer kann helfen?
Andreas.Fischer
Outlook - Moderator


Verfasst am:
07. Feb 2011, 09:45
Rufname:
Wohnort: Berlin

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Hallo BFE,

Öffne dir den VBA-Editor und setze den Cursor in das Script. Mit der Taste F8 gehe durch das Script. In welcher Zeile bekommst du die Fehlermeldung?

Welches Script verwendest du? Bitte verlinke zu dem Beitrag.

_________________
Gruß Andreas

Das besondere Erleben.
Sikind
Gast


Verfasst am:
03. März 2011, 13:44
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       Version: Office 2003

Liebe User,

ich habe mir das komplette Thema durchgelesen und komme einfach nicht dahinter wie und wo ich einen Standard-Ordner in dem Script unten einbauen kann, damit wenn ich auf den Button gehe mich nicht beim Ablegen der Emails durch die ganzen Ordner klicken muss, sondern gleich in mein Zielordner (F:\Transfer\E-Mails). Für eine Hilfe wäre ich euch echt dankbar.

Dieses Script habe ich in Verwendung:

Option Explicit

'-------------------------------------------------------------
' OPTIONS
'-------------------------------------------------------------
'Email format:
' MSG = Outlook msg format (incl. attachments, embedded objects etc.)., TXT = plain text
Private Const EXM_OPT_MAILFORMAT As String = "MSG"
'Date format of filename
Private Const EXM_OPT_FILENAME_DATEFORMAT As String = "dd-mm-yyyy_ss-nn-hh"
'Build filename; placeholders: <SENDER> for sender's name, <RECEIVER> for receiver, <SUBJECT> for subject, <DATE> for date,
Private Const EXM_OPT_FILENAME_BUILD As String = "<SENDER>_<SUBJECT>_<DATE>"
'Use browse folder? Set to FALSE if you don't want to use browser for selecting target folder
Private Const EXM_OPT_USEBROWSER As Boolean = True
'Target folder (used if EXM_OPT_USEBROWSER is set to FALSE)
Private Const EXM_OPT_TARGETFOLDER As String = "F:\Transfer\E-Mails"
'Maximum number of emails to be selected & exported. Please don't use a huge number as this will cause
'performance and maybe other issues. Recommended is a value between 5 and 20.
Private Const EXM_OPT_MAX_NO As Integer = 10
'Email subject prefixes (such us "RE:", "FW:" etc.) to be removed. Please note that this is a
'RegEx expression, google for "regex" for further information. For instance "\s" means blank " ".
Private Const EXM_OPT_CLEANSUBJECT_REGEX As String = "RE:\s|Re:\s|AW:\s|FW:\s|WG:\s|SV:\s|Antwort:\s"
'-------------------------------------------------------------


'-------------------------------------------------------------
' TRANSLATIONS
'-------------------------------------------------------------
'-- English
'Const EXM_007 = "Script terminated"
'Const EXM_013 = "Selected Outlook item is not an e-mail"
'Const EXM_014 = "File already exists"
'-- German
Private Const EXM_001 As String = "Die E-Mail wurde erfolgreich abgelegt."
Private Const EXM_002 As String = "Die E-Mail konnte nicht abgelegt werden, Grund:"
Private Const EXM_003 As String = "Ausgewählter Pfad:"
Private Const EXM_004 As String = "E-Mail(s) ausgewählt und erfolgreich abgelegt."
Private Const EXM_005 As String = "<FREE>"
Private Const EXM_006 As String = "<FREE>"
Private Const EXM_007 As String = "Script abgebrochen"
Private Const EXM_008 As String = "Fehler aufgetreten: Sie haben mehr als [LIMIT_SELECTED_ITEMS] E-Mails ausgewählt. Die Aktion wurde beendet."
Private Const EXM_009 As String = "Es wurde keine E-Mail ausgewählt."
Private Const EXM_010 As String = "Es ist ein Fehler aufgetreten: es war keine Email im Fokus, so dass die Ablage nicht erfolgen konnte."
Private Const EXM_011 As String = "Es ist ein Fehler aufgetreten:"
Private Const EXM_012 As String = "Die Aktion wurde beendet."
Private Const EXM_013 As String = "Ausgewähltes Outlook-Dokument ist keine E-Mail"
Private Const EXM_014 As String = "Datei existiert bereits"
Private Const EXM_015 As String = "<FREE>"
Private Const EXM_016 As String = "Bitte wählen Sie den Ordner zum Exportieren:"
Private Const EXM_017 As String = "Fehler beim Exportieren aufgetreten"
Private Const EXM_018 As String = "Export erfolgreich"
Private Const EXM_019 As String = "Bei [NO_OF_FAILURES] E-Mail(s) ist ein Fehler aufgetreten:"
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."
'-------------------------------------------------------------


'-------------------------------------
'For browse folder
'-------------------------------------
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Private Type BrowseInfo

hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Public Sub ExportEmailToDrive()

Const PROCNAME As String = "ExportEmailToDrive"

On Error GoTo ErrorHandler

Dim myExplorer As Outlook.Explorer
Dim myfolder As Outlook.MAPIFolder
Dim myItem As Object
Dim olSelection As Selection
Dim strBackuppath As String
Dim intCountAll As Integer
Dim intCountFailures As Integer
Dim strStatusMsg As String
Dim vSuccess As Variant
Dim strTemp1 As String
Dim strTemp2 As String
Dim strErrorMsg As String

'-------------------------------------
'Get target drive
'-------------------------------------
If (EXM_OPT_USEBROWSER = True) Then
strBackuppath = GetFileDir
If Left(strBackuppath, 15) = "ERROR_OCCURRED:" Then
strErrorMsg = Mid(strBackuppath, 16, 9999)
Error 5004
End If
Else
strBackuppath = EXM_OPT_TARGETFOLDER
End If
If strBackuppath = "" Then GoTo ExitScript
If (Not Right(strBackuppath, 1) = "\") Then strBackuppath = strBackuppath & "\"



'-------------------------------------
'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

'No email selected at all?
If myExplorer.Selection.Count = 0 Then Error 5003

Set olSelection = myExplorer.Selection
intCountAll = 0
intCountFailures = 0
For Each myItem In olSelection
intCountAll = intCountAll + 1
vSuccess = ProcessEmail(myItem, strBackuppath)
If (Not vSuccess = True) Then
Select Case intCountFailures
Case 0: strStatusMsg = vSuccess
Case 1: strStatusMsg = "1x " & strStatusMsg & Chr(10) & "1x " & vSuccess
Case Else: strStatusMsg = strStatusMsg & Chr(10) & "1x " & vSuccess
End Select
intCountFailures = intCountFailures + 1
End If
Next
If intCountFailures = 0 Then
strStatusMsg = intCountAll & " " & EXM_004
End If


'Final Message
If (intCountFailures = 0) Then 'No failure occurred
MsgBox strStatusMsg & Chr(10) & Chr(10) & EXM_003 & " " & strBackuppath, 64, EXM_018
ElseIf (intCountAll = 1) Then 'Only one email was selected and a failure occurred
MsgBox EXM_002 & Chr(10) & vSuccess & Chr(10) & Chr(10) & EXM_003 & " " & strBackuppath, 48, EXM_017
Else 'More than one email was selected and at least one failure occurred
strTemp1 = Replace(EXM_020, "[NO_OF_SELECTED_ITEMS]", intCountAll)
strTemp1 = Replace(strTemp1, "[NO_OF_SUCCESS_ITEMS]", intCountAll - intCountFailures)
strTemp2 = Replace(EXM_019, "[NO_OF_FAILURES]", intCountFailures)
MsgBox strTemp1 & Chr(10) & Chr(10) & strTemp2 & Chr(10) & Chr(10) & strStatusMsg _
& Chr(10) & Chr(10) & EXM_003 & " " & strBackuppath, 48, EXM_017
End If


ExitScript:
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 5001: 'Not an email
MsgBox EXM_010, 64, EXM_007
Case 5002:
MsgBox Replace(EXM_008, "[LIMIT_SELECTED_ITEMS]", EXM_OPT_MAX_NO), 64, EXM_007
Case 5003:
MsgBox EXM_009, 64, EXM_007
Case 5004:
MsgBox EXM_011 & Chr(10) & Chr(10) & strErrorMsg, 48, EXM_007
Case Else:
MsgBox EXM_011 & Chr(10) & Chr(10) _
& Err & " - " & Error$ & Chr(10) & Chr(10) & EXM_012, 48, EXM_007
End Select
Resume ExitScript
End Sub

Private Function ProcessEmail(myItem As Object, strBackuppath As String) As Variant
'Saves the e-mail on the drive by using the provided path.
'Returns TRUE if successful, and FALSE otherwise.

Const PROCNAME As String = "ProcessEmail"

On Error GoTo ErrorHandler

Dim myMailItem As MailItem
Dim strDate As String
Dim strSender As String
Dim strReceiver As String
Dim strSubject As String
Dim strFinalFileName As String
Dim strFullPath As String
Dim vExtConst As Variant
Dim vTemp As String
Dim strErrorMsg As String

If TypeOf myItem Is MailItem Then
Set myMailItem = myItem
Else
Error 1001
End If

'Set filename
strDate = Format(myMailItem.ReceivedTime, EXM_OPT_FILENAME_DATEFORMAT)
strSender = myMailItem.SenderName
strReceiver = myMailItem.To 'All receiver, semikolon separated string
If InStr(strReceiver, ";") > 0 Then strReceiver = Left(strReceiver, InStr(strReceiver, ";") - 1)
strSubject = myMailItem.Subject
strFinalFileName = EXM_OPT_FILENAME_BUILD
strFinalFileName = Replace(strFinalFileName, "<DATE>", strDate)
strFinalFileName = Replace(strFinalFileName, "<SENDER>", strSender)
strFinalFileName = Replace(strFinalFileName, "<RECEIVER>", strReceiver)
strFinalFileName = Replace(strFinalFileName, "<SUBJECT>", strSubject)
strFinalFileName = CleanString(strFinalFileName)
If Left(strFinalFileName, 15) = "ERROR_OCCURRED:" Then
strErrorMsg = Mid(strFinalFileName, 16, 9999)
Error 1003
End If
strFinalFileName = IIf(Len(strFinalFileName) > 251, Left(strFinalFileName, 251), strFinalFileName)
strFullPath = strBackuppath & strFinalFileName

'Save as msg or txt?
Select Case UCase(EXM_OPT_MAILFORMAT)
Case "MSG":
strFullPath = strFullPath & ".msg"
vExtConst = olMSG
Case Else:
strFullPath = strFullPath & ".txt"
vExtConst = olTXT
End Select
'File already exists?
If CreateObject("Scripting.FileSystemObject").FileExists(strFullPath) = True Then
Error 1002
End If

'Save file
myMailItem.SaveAs strFullPath, vExtConst

'Return true as everything was successful
ProcessEmail = True

ExitScript:
Exit Function
ErrorHandler:
Select Case Err.Number
Case 1001: 'Not an email
ProcessEmail = EXM_013
Case 1002:
ProcessEmail = EXM_014
Case 1003:
ProcessEmail = strErrorMsg
Case Else:
ProcessEmail = "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
End Select
Resume ExitScript
End Function


Private Function CleanString(strData As String) As String

Const PROCNAME As String = "CleanString"

On Error GoTo ErrorHandler

'Instantiate RegEx
Dim objRegExp As Object
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True

'Cut out strings we don't like
objRegExp.Pattern = EXM_OPT_CLEANSUBJECT_REGEX
strData = objRegExp.Replace(strData, "")

'Replace and cut out invalid strings.
strData = Replace(strData, Chr(9), "_")
strData = Replace(strData, Chr(10), "_")
strData = Replace(strData, Chr(13), "_")
objRegExp.Pattern = "[/\\*]"
strData = objRegExp.Replace(strData, "-")
objRegExp.Pattern = "[""]"
strData = objRegExp.Replace(strData, "'")
objRegExp.Pattern = "[Confused<>\|]"
strData = objRegExp.Replace(strData, "")

'Replace multiple chars by 1 char
objRegExp.Pattern = "\s+"
strData = objRegExp.Replace(strData, " ")
objRegExp.Pattern = "_+"
strData = objRegExp.Replace(strData, "_")
objRegExp.Pattern = "-+"
strData = objRegExp.Replace(strData, "-")
objRegExp.Pattern = "'+"
strData = objRegExp.Replace(strData, "'")

'Trim
strData = Trim(strData)

'Return result
CleanString = strData


ExitScript:
Exit Function
ErrorHandler:
CleanString = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
Resume ExitScript
End Function

Private Function GetFileDir() As String

Const PROCNAME As String = "GetFileDir"

On Error GoTo ErrorHandler

Dim ret As String
Dim lpIDList As Long
Dim sPath As String
Dim udtBI As BrowseInfo
Dim RdStrings() As String
Dim nNewFiles As Long

'Show a browse-for-folder form:
With udtBI
.lpszTitle = lstrcat(EXM_016, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With

lpIDList = SHBrowseForFolder(udtBI)
If lpIDList = 0 Then Exit Function

'Get the selected folder.
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList lpIDList, sPath
CoTaskMemFree lpIDList

'Strip Nulls
If (InStr(sPath, Chr$(0)) > 0) Then sPath = Left$(sPath, InStr(sPath, Chr(0)) - 1)

'Return Dir
GetFileDir = sPath

ExitScript:
Exit Function
ErrorHandler:
GetFileDir = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
Resume ExitScript
End Function

Gruß S.K.
loopy01
Gast


Verfasst am:
19. Aug 2011, 16:03
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

Hallo,
echt klasse.

Ich habe folgende Frage und Bitte:
meiner Ordner-struktur unter Outlook ist 1 zu 1 auf einem LW nachgebildet unter E:Mails\Outlook\.
Folgendes möchte ich machen: beim Klicken auf eine Mail mit Anhang soll dieser Anhang in das Unterverzwichnis unter E:Mails\Outlook\ gespeichert werden, in welchem es sich in Outlook bfindet.

Könntet ihr dafür das gesamte Script zur verfügung stellen, da ich nicht VBA-firm bin?

Gruß,
loopy
DeafNut
Gast


Verfasst am:
09. Sep 2011, 13:59
Rufname:

AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       

@looby: Wenn du deine Mails in ein festes Verzeichnis ablegen möchtest, ist das ganz einfach:

In dem Script ganz oben unter OPTIONEN findest du die Zeile

Private Const EXM_OPT_USEBROWSER As Boolean = True

Hier statt TRUE das Wort FALSE einfügen.

In der Zeile darunter musst du nun deinen Pfad eingeben. Das ganze speichern und schon legt er ohne Pfadabfrage deine Mails ab.

Zum ganzen Thema, schade das bis jetzt noch keine Lösung gefunden wurde, wie man den Ausgangspfad ändern kann. Würde mich auch brennend Interessieren.
jannick
Im Profil kannst Du frei den Rang ändern


Verfasst am:
10. Sep 2011, 21:24
Rufname:


AW: Outlook-Script zum Speichern einer Mail - AW: Outlook-Script zum Speichern einer Mail

Nach oben
       Version: Office 2003

Hallo zusammen,

hier ein kleiner Versuch, das Makro in Englisch, das nur Emails auf der Festplatte abspeichert, um folgende optionale Features - auch mit Hilfe des anderen Makros in diesem Thread - zu erweitern. Entsprechende Optionen sind in der Präambel des Makros zu setzen:

  • Ordner, in der Email abgespeichert wird, kann um den Namen des Outlook-Ordners erweitert werden
  • Attachments abspeichern
  • Absender in Dateinamen der Email auf Festplatte kann in Kontakteordner gesucht werden (kleiner Wermutstropfen: Bestätigung, dass auf Kontakteordner zugegriffen werden darf; nimm einfach maximale Zeit, 10 Min. ... aber hier scheint geholfen zu werden)
  • Flag (Haken) für abgespeicherte Email (im Code schon vorbereitet: kann auch auf farbiges Flag umgesetzt werden)
  • Verschiedene Datum/Zeit-Formate vorgeschlagen

Ich hoffe ich habe alle neuen Features aufgezählt.



Code:
Option Explicit

'-------------------------------------------------------------
' OPTIONS
'-------------------------------------------------------------
'Email format:
' MSG = Outlook msg format (incl. attachments, embedded objects etc.)., TXT = plain text
Private Const EXM_OPT_MAILFORMAT As String = "MSG"

' Set email flag (hook) in email folder after saving in folder
Private Const EXM_OPT_MailFLAG As Boolean = False

'Date format of filename
'Private Const EXM_OPT_FILENAME_DATEFORMAT As String = "yyyymmdd_hh_mm_ss"
'Private Const EXM_OPT_FILENAME_DATEFORMAT As String = "yyyy-mmm-dd hh_mm"  ' month like Jan, Feb, ...
Private Const EXM_OPT_FILENAME_DATEFORMAT As String = "yyyy-mm-dd hh_mm"  ' month like 01, 02, ...

'Retrieve last name from contact folder
Private Const EXM_OPT_NAMES As Boolean = True

'File saved in folder named after Outlook folder email is found in (TRUE, else FALSE)
Private Const EXM_OPT_FOLDER As Boolean = True

'Build filename; placeholders: <DATE> for date, <SENDER> for sender's name,
' <RECEIVER> for receiver, <SUBJECT> for subject
Private Const EXM_OPT_FILENAME_BUILD As String = "<DATE>_<SUBJECT>_<SENDER>_<INDEX>"

'Use browse folder? Set to FALSE if you don't want to use browser for selecting target folder
Private Const EXM_OPT_USEBROWSER As Boolean = False

'Target folder (used if EXM_OPT_USEBROWSER is set to FALSE)
Private Const EXM_OPT_TARGETFOLDER As String = "C:\temp"

'Maximum number of emails to be selected & exported. Please don't use a huge number as this will cause
'performance and maybe other issues. Recommended is a value between 5 and 20.
Private Const EXM_OPT_MAX_NO As Integer = 500

'Email subject prefixes (such us "RE:", "FW:" etc.) to be removed. Please note that this is a
'RegEx expression, google for "regex" for further information. For instance "\s" means blank " ".
Private Const EXM_OPT_CLEANSUBJECT_REGEX As String = "RE:\s|Re:\s|AW:\s|FW:\s|WG:\s|SV:\s|Antwort:\s"

'Save attachments if set TRUE below
Private Const EXM_OPT_SAVE_ATTACH As Boolean = True

'-------------------------------------------------------------


'-------------------------------------------------------------
' TRANSLATIONS
'-------------------------------------------------------------
'-- English
'Const EXM_007 = "Script terminated"
'Const EXM_013 = "Selected Outlook item is not an e-mail"
'Const EXM_014 = "File already exists"
'-- German
Private Const EXM_001 As String = "Die E-Mail wurde erfolgreich abgelegt."
Private Const EXM_002 As String = "Die E-Mail konnte nicht abgelegt werden, Grund:"
Private Const EXM_003 As String = "Ausgewählter Pfad:"
Private Const EXM_004 As String = "E-Mail(s) ausgewählt und erfolgreich abgelegt."
Private Const EXM_005 As String = "<FREE>"
Private Const EXM_006 As String = "<FREE>"
Private Const EXM_007 As String = "Script abgebrochen"
Private Const EXM_008 As String = "Fehler aufgetreten: Sie haben mehr als [LIMIT_SELECTED_ITEMS] E-Mails ausgewählt. Die Aktion wurde beendet."
Private Const EXM_009 As String = "Es wurde keine E-Mail ausgewählt."
Private Const EXM_010 As String = "Es ist ein Fehler aufgetreten: es war keine Email im Fokus, so dass die Ablage nicht erfolgen konnte."
Private Const EXM_011 As String = "Es ist ein Fehler aufgetreten:"
Private Const EXM_012 As String = "Die Aktion wurde beendet."
Private Const EXM_013 As String = "Ausgewähltes Outlook-Dokument ist keine E-Mail"
Private Const EXM_014 As String = "Datei existiert bereits"
Private Const EXM_015 As String = "<FREE>"
Private Const EXM_016 As String = "Bitte wählen Sie den Ordner zum Exportieren:"
Private Const EXM_017 As String = "Fehler beim Exportieren aufgetreten"
Private Const EXM_018 As String = "Export erfolgreich"
Private Const EXM_019 As String = "Bei [NO_OF_FAILURES] E-Mail(s) ist ein Fehler aufgetreten:"
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."
'-------------------------------------------------------------


'-------------------------------------
'For browse folder
'-------------------------------------
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hmem As Long)
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Private Type BROWSEINFO

    hwndOwner As Long
    pidlRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

Public Sub ExportEmailToDrive()
   
    Const PROCNAME As String = "ExportEmailToDrive"
   
    On Error GoTo ErrorHandler
   
    Dim myExplorer As Outlook.Explorer
    'Dim myNamespace As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim myContactFolder As Object
    Dim myItem As Object
    Dim olSelection As Selection
    Dim strBackupPath As String
    Dim strFolder As String
    Dim intCountAll As Integer
    Dim intCountFailures As Integer
    Dim strStatusMsg As String
    Dim vSuccess As Variant
    Dim strTemp1 As String
    Dim strTemp2 As String
    Dim strErrorMsg As String
 
    '-------------------------------------
    'Get target drive
    '-------------------------------------
    If (EXM_OPT_USEBROWSER = True) Then
        strBackupPath = GetFileDir
        If Left(strBackupPath, 15) = "ERROR_OCCURRED:" Then
            strErrorMsg = Mid(strBackupPath, 16, 9999)
            Error 5004
        End If
    Else
        strBackupPath = EXM_OPT_TARGETFOLDER
    End If
    If strBackupPath = "" Then GoTo ExitScript
    If (Not Right(strBackupPath, 1) = "\") Then strBackupPath = strBackupPath & "\"
   
   
 
    '-------------------------------------
    '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
     
    'No email selected at all?
    If myExplorer.Selection.Count = 0 Then Error 5003
     
   
    Set olSelection = myExplorer.Selection
    intCountAll = 0
    intCountFailures = 0
   
    If (EXM_OPT_FOLDER = True) Then strBackupPath = strBackupPath & myFolder.name & "\"
   
    For Each myItem In olSelection
   
        intCountAll = intCountAll + 1
        vSuccess = ProcessEmail(myItem, strBackupPath, myFolder)
       
               If (Not vSuccess = True) Then
            Select Case intCountFailures
                Case 0: strStatusMsg = vSuccess
                Case 1: strStatusMsg = "1x " & strStatusMsg & Chr(10) & "1x " & vSuccess
                Case Else: strStatusMsg = strStatusMsg & Chr(10) & "1x " & vSuccess
            End Select
            intCountFailures = intCountFailures + 1
        End If
    Next
    If intCountFailures = 0 Then
        strStatusMsg = intCountAll & " " & EXM_004
    End If

       
    'Final Message
    If (intCountFailures = 0) Then  'No failure occurred
        MsgBox strStatusMsg & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 64, EXM_018
    ElseIf (intCountAll = 1) Then   'Only one email was selected and a failure occurred
        MsgBox EXM_002 & Chr(10) & vSuccess & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 48, EXM_017
    Else    'More than one email was selected and at least one failure occurred
        strTemp1 = Replace(EXM_020, "[NO_OF_SELECTED_ITEMS]", intCountAll)
        strTemp1 = Replace(strTemp1, "[NO_OF_SUCCESS_ITEMS]", intCountAll - intCountFailures)
        strTemp2 = Replace(EXM_019, "[NO_OF_FAILURES]", intCountFailures)
        MsgBox strTemp1 & Chr(10) & Chr(10) & strTemp2 & Chr(10) & Chr(10) & strStatusMsg _
        & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 48, EXM_017
    End If


ExitScript:
    Exit Sub
ErrorHandler:
    Select Case Err.Number
    Case 5001:  'Not an email
        MsgBox EXM_010, 64, EXM_007
    Case 5002:
        MsgBox Replace(EXM_008, "[LIMIT_SELECTED_ITEMS]", EXM_OPT_MAX_NO), 64, EXM_007
    Case 5003:
        MsgBox EXM_009, 64, EXM_007
    Case 5004:
        MsgBox EXM_011 & Chr(10) & Chr(10) & strErrorMsg, 48, EXM_007
    Case Else:
        MsgBox EXM_011 & Chr(10) & Chr(10) _
        & Err & " - " & Error$ & Chr(10) & Chr(10) & EXM_012, 48, EXM_007
    End Select
    Resume ExitScript
End Sub

Private Function ProcessEmail(myItem As Object, strBackupPath As String, olFolder As Variant) As Variant
    'Saves the e-mail on the drive by using the provided path.
    'Returns TRUE if successful, and FALSE otherwise.

    Const PROCNAME As String = "ProcessEmail"

    On Error GoTo ErrorHandler

    Dim myMailItem As MailItem
    Dim strDate As String
    Dim strSender As String
    Dim strReceiver As String
    Dim strSubject As String
    Dim strFinalFileName As String
    Dim strFullPath As String
    Dim vExtConst As Variant
    Dim vTemp As String
    Dim strErrorMsg As String
    Dim intIndex As Integer
    Dim strIndex As String
    Dim lngAttCount As Long
    Dim i As Integer
    Dim strName As String
    Dim strsubdir As String
    Dim datei As String
    Dim Dateiname As String
    Dim DateiNameNeu As String
    Dim Dateiendung As String
    Dim geändert As Boolean
    Dim nummer As Integer
    Dim Prüfname As String
    Dim strFolder As String
    Dim retFindContact As Variant
   
    If TypeOf myItem Is MailItem Then
         Set myMailItem = myItem
         
    Else
        Error 1001
    End If

    'Set filename
    strDate = Format(myMailItem.ReceivedTime, EXM_OPT_FILENAME_DATEFORMAT)
   
    If myMailItem.SentOnBehalfOfName = myMailItem.SenderName Then
        strSender = myMailItem.SenderName
        Else: strSender = myMailItem.SentOnBehalfOfName
    End If
   
    'look for last name in contact folder
    If (EXM_OPT_NAMES = True) Then
        retFindContact = FindContact(myMailItem.SenderEmailAddress)
        If (Not retFindContact = False) Then strSender = retFindContact
    End If
   
    strReceiver = myMailItem.To 'All receiver, semikolon separated string
    If InStr(strReceiver, ";") > 0 Then strReceiver = Left(strReceiver, InStr(strReceiver, ";") - 1)
       
   
    strIndex = CStr(intIndex)
   
    strSubject = myMailItem.Subject
   
    strFinalFileName = EXM_OPT_FILENAME_BUILD
    strFinalFileName = Replace(strFinalFileName, "<DATE>", strDate)
    strFinalFileName = Replace(strFinalFileName, "<SENDER>", strSender)
    strFinalFileName = Replace(strFinalFileName, "<RECEIVER>", strReceiver)
    strFinalFileName = Replace(strFinalFileName, "<SUBJECT>", strSubject)
    strFinalFileName = Replace(strFinalFileName, "<INDEX>", strIndex)
       
    strFinalFileName = CleanString(strFinalFileName)
   
    If Left(strFinalFileName, 15) = "ERROR_OCCURRED:" Then
        strErrorMsg = Mid(strFinalFileName, 16, 9999)
        Error 1003
    End If
    strFinalFileName = IIf(Len(strFinalFileName) > 251, Left(strFinalFileName, 251), strFinalFileName)
   
    strFolder = strBackupPath
    strFullPath = strFolder & strFinalFileName
   
    'Save as msg or txt?
    Select Case UCase(EXM_OPT_MAILFORMAT)
        Case "MSG":
            strFullPath = strFullPath & ".msg"
            vExtConst = olMSG
        Case Else:
            strFullPath = strFullPath & ".txt"
            vExtConst = olTXT
    End Select
   
    If Dir(strFolder, vbDirectory) = "" Then
        If (Not MakeDirectory(strFolder) = True) Then GoTo ErrorHandler
    End If
   
    'File already exists?
    If CreateObject("Scripting.FileSystemObject").FileExists(strFullPath) = True Then
        strIndex = strIndex + 1
    End If
   
    'Save file
    myMailItem.SaveAs strFullPath, vExtConst
   
    'Set flag of saved email in Outlook folder
        If (EXM_OPT_MailFLAG = True) Then
            myMailItem.FlagStatus = olFlagComplete             ' hook
            'mymailitem.FlagIcon = olBlueFlagIcon              ' blue flag
            myMailItem.Save
        End If
       
    ' Save attachments
    If (EXM_OPT_SAVE_ATTACH = True) Then
       
        lngAttCount = myItem.Attachments.Count
        If lngAttCount > 0 Then
        For i = lngAttCount To 1 Step -1
   
         With myMailItem.Attachments.Item(i)
         
          strName = IIf(Len(strBackupPath & myMailItem.Subject) > 255, _
                    Left(myMailItem.Subject, 255 - Len(strBackupPath)), myMailItem.Subject)
                   
          strsubdir = strFolder & CleanString(strName)
   
           If Dir(strsubdir, vbDirectory) = "" Then
                If (Not MakeDirectory(strsubdir) = True) Then GoTo ErrorHandler
           End If
   
    '    Datei schon gespeichert
          datei = strsubdir & "\" & .FileName
          geändert = False
          nummer = 1
          Prüfname = datei
Zurück:
   
          nummer = nummer + 1
   
           If CreateObject("Scripting.FileSystemObject").FileExists(Prüfname) = True Then
            Dateiname = CreateObject("Scripting.FileSystemObject").GetBaseName(datei)
            Dateiendung = CreateObject("Scripting.FileSystemObject").GetExtensionName(datei)
            DateiNameNeu = Dateiname & " (" & nummer & ")" & "." & Dateiendung
            Prüfname = strsubdir & "\" & DateiNameNeu
            geändert = True
            GoTo Zurück:
           Else
            If geändert = False Then DateiNameNeu = .FileName
           End If
   
         .SaveAsFile strsubdir & "\" & DateiNameNeu
        End With
       Next
      Else
      End If
  End If
 
    'Return true as everything was successful
    ProcessEmail = True

ExitScript:
    Exit Function
ErrorHandler:
    Select Case Err.Number
    Case 1001:  'Not an email
        ProcessEmail = EXM_013
    Case 1002:
        ProcessEmail = EXM_014
    Case 1003:
        ProcessEmail = strErrorMsg
    Case Else:
        ProcessEmail = "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
    End Select
    Resume ExitScript
End Function


Function FindContact(strEmailAddress As String) As Variant
    ' looks for name in default contact folder to given email address
    ' Return: either last name firstly found  given to email address or boolean FALSE

    Dim iContact    As Long
    Dim iFolder     As Long
    Dim found       As Boolean         ' was found?
   
    Dim activContact As Object
    Dim allAddresses      As Variant
    Dim iAddress         As Long
    Dim actAddress       As String
   
    Dim myolApp     As Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myFolder    As Object
   
    Set myolApp = CreateObject("Outlook.Application")
    Set myNamespace = myolApp.GetNamespace("MAPI")
    Set myFolder = myNamespace.GetDefaultFolder(olFolderContacts)
       
    found = False
    If myFolder.Class = olFolder Then
        If myFolder.DefaultItemType = olContactItem Then
            iContact = 1
            Do While Not found And iContact <= myFolder.Items.Count
                Set activContact = myFolder.Items(iContact)
                With activContact
                    If .Class = olContact And Not strEmailAddress = "" Then
                            allAddresses = Array(.Email1Address, .Email2Address, .Email3Address)
                            iAddress = LBound(allAddresses)
                            Do While Not found And iAddress <= UBound(allAddresses)
                                If Not Len(allAddresses(iAddress)) = 0 Then
                                    actAddress = allAddresses(iAddress)
                                    If LCase(strEmailAddress) = LCase(actAddress) Then found = True
                                End If
                                iAddress = iAddress + 1
                            Loop
                        End If
                    End With
                iContact = iContact + 1
            Loop
        End If
    End If
   
    If found = True Then
    FindContact = activContact.LastName
    'FindContact = FindContact & ", " & activContact.FirstName
    Else: FindContact = found
    End If

TidyUp:
    Set activContact = Nothing
    Set myFolder = Nothing
    Set myNamespace = Nothing
    Set myolApp = Nothing
   
End Function '(FindContact)

 Function CleanString(strData As String) As String

    Const PROCNAME As String = "CleanString"

    On Error GoTo ErrorHandler

    'Instantiate RegEx
    Dim objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True

    'Cut out strings we don't like
    objRegExp.Pattern = EXM_OPT_CLEANSUBJECT_REGEX
    strData = objRegExp.Replace(strData, "")

    'Replace and cut out invalid strings.
    strData = Replace(strData, Chr(9), "_")
    strData = Replace(strData, Chr(10), "_")
    strData = Replace(strData, Chr(13), "_")
    objRegExp.Pattern = "[/\\*]"
    strData = objRegExp.Replace(strData, "-")
    objRegExp.Pattern = "[""]"
    strData = objRegExp.Replace(strData, "'")
    objRegExp.Pattern = "[:?<>\|]"
    strData = objRegExp.Replace(strData, "")
   
    'Replace multiple chars by 1 char
    objRegExp.Pattern = "\s+"
    strData = objRegExp.Replace(strData, " ")
    objRegExp.Pattern = "_+"
    strData = objRegExp.Replace(strData, "_")
    objRegExp.Pattern = "-+"
    strData = objRegExp.Replace(strData, "-")
    objRegExp.Pattern = "'+"
    strData = objRegExp.Replace(strData, "'")
           
    'Trim
    strData = Trim(strData)
   
    'Return result
    CleanString = strData
 
 
ExitScript:
    Exit Function
ErrorHandler:
    CleanString = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
    Resume ExitScript
End Function

Private Function GetFileDir() As String
   
    Const PROCNAME As String = "GetFileDir"

    On Error GoTo ErrorHandler

    Dim ret As String
    Dim lpIDList As Long
    Dim sPath As String
    Dim udtBI As BROWSEINFO
    Dim RdStrings() As String
    Dim nNewFiles As Long

    'Show a browse-for-folder form:
    With udtBI
        .lpszTitle = lstrcat(EXM_016, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList = 0 Then Exit Function
       
    'Get the selected folder.
    sPath = String$(MAX_PATH, 0)
    SHGetPathFromIDList lpIDList, sPath
    CoTaskMemFree lpIDList
   
    'Strip Nulls
    If (InStr(sPath, Chr$(0)) > 0) Then sPath = Left$(sPath, InStr(sPath, Chr(0)) - 1)

    'Return Dir
    GetFileDir = sPath

ExitScript:
    Exit Function
ErrorHandler:
    GetFileDir = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
    Resume ExitScript
End Function

Private Function MakeDirectory(ByVal sPath As String, _
  Optional ByVal blnRaiseError As Boolean = True) As Boolean
 
  ' Fehlerbehandlung aktivieren
  On Error GoTo ErrorHandler
 
  Dim sTempPath As String
  Dim i As Integer
 
  ' ggf. abschl. Backslash anfügen
  If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
 
  ' Teilpfade
  Dim sPart() As String
  sPart = Split(sPath, "\")
 
  ' jetzt alle Pfade durchlaufen
  For i = LBound(sPart) To UBound(sPart) - 1
    ' Pfad zusammensetzen
    sTempPath = sTempPath & sPart(i) & "\"
 
    ' Falls das Verzeichnis noch nicht existiert...
    If Len(Dir(sTempPath, vbDirectory)) = 0 Then
      ' ...jetzt erstellen
      MkDir sTempPath
    End If
  Next i
  MakeDirectory = True
  Exit Function
 
ErrorHandler:
  If blnRaiseError Then
    Err.Raise Err.Number, Source:="MakeDirectory:", _
      Description:="Unerwartete Ausnahme bei der Verzeichniserstellung: " & sPath
  End If
End Function
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Gehe zu Seite Zurück  1, 2, 3, 4, 5, 6, 7, 8, 9  Weiter
Diese Seite Freunden empfehlen

Seite 8 von 9
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Outlook Mail: Mail Absender falsch 8 Jürgen Eitler 3343 09. Sep 2005, 13:52
Gast Mail Absender falsch
Keine neuen Beiträge Outlook Mail: Outlook 2003 erste Mail wird nicht verschickt 6 Gast 2734 25. Aug 2005, 13:00
Krug Outlook 2003 erste Mail wird nicht verschickt
Keine neuen Beiträge Outlook Mail: Automatische Antworts mail (Urlaubsfunktion) 1 player-1 2825 21. Jul 2005, 20:04
wolf-it Automatische Antworts mail (Urlaubsfunktion)
Keine neuen Beiträge Outlook Mail: Outlook 2003 / Mail Weiterleiten / ich will es merken 4 Iceman008 1595 14. Jul 2005, 10:50
kraemer Outlook 2003 / Mail Weiterleiten / ich will es merken
Keine neuen Beiträge Outlook Mail: Kann man jede Adresse einer eingehenden Mail aut. speichern? 4 landau666 1425 13. Jul 2005, 17:21
Christi@n Kann man jede Adresse einer eingehenden Mail aut. speichern?
Keine neuen Beiträge Outlook Mail: Arbeitsspeicherprob. beim Anlagenhinzufügen einer neuen Mail 4 Tischler 995 11. Jul 2005, 15:19
Christi@n Arbeitsspeicherprob. beim Anlagenhinzufügen einer neuen Mail
Keine neuen Beiträge Outlook Mail: Abwesenheitsassistent, Mails weiterleiten zu ext. Mail 1 nicksan 1929 22. Feb 2005, 11:45
kraemer Abwesenheitsassistent, Mails weiterleiten zu ext. Mail
Keine neuen Beiträge Outlook Mail: Adressauswahl bei neuem Mail gestört 10 swissbird 912 19. Feb 2005, 15:49
macdeal Adressauswahl bei neuem Mail gestört
Keine neuen Beiträge Outlook Mail: Standard Dateiendung bei Speichern von E-Mails ändern 5 S.Thielen 4414 02. Feb 2005, 12:04
kraemer Standard Dateiendung bei Speichern von E-Mails ändern
Keine neuen Beiträge Outlook Mail: Mails in Extra Ordner speichern. 4 Jason 2540 30. Jan 2005, 14:51
Christi@n Mails in Extra Ordner speichern.
Keine neuen Beiträge Outlook Mail: Wie schreibe ich eine html - Mail mit outlook 2 Mike020174 13305 21. Jan 2005, 02:35
Gast Wie schreibe ich eine html - Mail mit outlook
Keine neuen Beiträge Outlook Mail: manuell mail verschicken 2 redrogue 801 04. Jan 2005, 19:13
redrogue manuell mail verschicken
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Microsoft Excel-Formeln