Outlook und vba script

S.a.M.

Commander
Dabei seit
Nov. 2006
Beiträge
2.902
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:

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
 

S.a.M.

Commander
Ersteller dieses Themas
Dabei seit
Nov. 2006
Beiträge
2.902
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
 
Zuletzt bearbeitet:
Top