Clanintern Clanintern Clanintern

Forum

Öffentliche Foren
FORUM: Spiele & Computer THEMA: outlook mails mit makro exportieren
AUTOR BEITRAG
S.A.M.

RANG Master of Clanintern

#1 - 17.08 19:34

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