Outlook und vba script

[S.a.M.]

hi ihr

hab auf ner anderen seite ein vba script gefunden.
dieses speichert mit allerdings immer alle emails im posteingang (nit die in den unterordnern)

ich hätte es aber gerne so, dass er mir jeweils die markierten emails speichert.
den speicherort angeben würde ich auch gern.

leider kenn ich mich mit vba zuwenig aus.

als dateinamenformat hätte ich gerne : yyyy-mm-dd_Betreff_absender
das mit dem betreff und abesender klappt eigentlich auch, aber das datum irgendwie nicht

könnt ihr mir bitte helfen ?

danke

hier noch der code:

Option Explicit  

Sub SaveAsrtf()  
Dim myExplorer As Explorer  
Dim myFolder As MAPIFolder  
Dim strFileName As String * 150  
Dim myItems As Items  
Dim myItem As MailItem  
Dim myNameSpace As NameSpace  
Dim Datum As Date  
Dim Absender As String  

Set myExplorer = ActiveExplorer  
Set myNameSpace = Outlook.GetNamespace("MAPI")  
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)  
Set myItems = myFolder.Items  

On Error Resume Next  

For Each myItem In myItems  
Datum = Format(myItem.SentOn, "yy mm dd")  
Absender = myItem.SenderName  
strFileName = Datum & " " &  myItem.Subject  & " " & Absender 
myItem.SaveAs "C:\temp" & CleanString(strFileName) & ".rtf", olrtf  
Next  
End Sub  

Private Function CleanString(strData As String) As String  
'Replace invalid strings.  
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, ":", "")  
'Cut out invalid signs.  
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 As String  
Dim 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

 

[Ria]

Hallo,

vielleicht hilft Dir ein Freeware-AddIn* weiter, mit dem Du einzelne oder mehrere markierte Mails in beliebigen Festplattenverzeichnissen speichern kannst.

SmartTools Message Saver für Outlook - Link hierzu: http://www.add-in-world.com/katalog/ol-saveas/

mfg

Ria

* Outlook 2000, 2002/XP oder 2003

 

[S.a.M.]

ein tool zum installieren ist eigentlich nicht, was ich suche

aber danke trotzdem

- edit -

hat sonst keiner eine idee ?


- edit 2 -

hab grad bemerkt, dass der thread im falschen bereich gelandet ist.
eigentlich sollte er ins "Office und Text" oder ins "Programmieren" da hab ich mich wohl verklickt.
kann das ein mod plz verschieben ?
danke