Ik zou graag mijn emails als volgt willen opslaan (YYYYMMDD_van-naar_Subject.msg)
YYYY= jaar
MM=maand
DD=dag
van= email van contactpersoon (oMail.Sender)
naar= email naar contactpersoon (oMail.To)
De code werkt alleen ik krijg nu de gehele voor en achternaam te zien als ik deze opslaat.
Maar eigenlijk zou ik graag de 1e letter van de voornaam en 2 letters van de achternaam daarin willen verwerken.
bijvoorbeeld piet jansen = PJA stuurd email naar klaas bakker = KBA
voorbeeld = 20141024_PJA-KBA_Email.msg
Hieronder de code, ik kom hier verder niet uit hoe ik dit kan oplossen
Option Explicit
Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
Set oMail = objItem
sName = oMail.subject
ReplaceCharsForFileName sName, "_"
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnn", _
vbUseSystemDayOfWeek, vbUseSystem) & "_" & oMail.Sender & "-" & oMail.To & "_" & sName & ".msg"
sPath = "d:\user\Desktop\Inbox\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG
Next
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
YYYY= jaar
MM=maand
DD=dag
van= email van contactpersoon (oMail.Sender)
naar= email naar contactpersoon (oMail.To)
De code werkt alleen ik krijg nu de gehele voor en achternaam te zien als ik deze opslaat.
Maar eigenlijk zou ik graag de 1e letter van de voornaam en 2 letters van de achternaam daarin willen verwerken.
bijvoorbeeld piet jansen = PJA stuurd email naar klaas bakker = KBA
voorbeeld = 20141024_PJA-KBA_Email.msg
Hieronder de code, ik kom hier verder niet uit hoe ik dit kan oplossen
Option Explicit
Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
Set oMail = objItem
sName = oMail.subject
ReplaceCharsForFileName sName, "_"
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnn", _
vbUseSystemDayOfWeek, vbUseSystem) & "_" & oMail.Sender & "-" & oMail.To & "_" & sName & ".msg"
sPath = "d:\user\Desktop\Inbox\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG
Next
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
Laatst bewerkt: