emails opslaan (yyyymmdd_van-naar_subject.msg)

Status
Niet open voor verdere reacties.

thorry

Gebruiker
Lid geworden
14 nov 2008
Berichten
40
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
 
Laatst bewerkt:
Daar kun je de Left functie voor gebruiken. Je laat alleen niet zien waar de voor- en achternaam vandaan komen dus de rest zul je zelf moeten invullen.
 
Dank je wel voor het reageren Ed.
Dat weet ik dat je daar left functie voor kan gebruiken alleen weet ik niet hoe ik aan de voor en achternaam kan komen zodat ik deze kan toepassen vandaar mijn vraag

vbUseSystemDayOfWeek, vbUseSystem) & "_" & oMail.Sender & "-" & oMail.To & "_" & sName & ".msg"

De in het rood aangegeven zou ik hier willen plaatsen alleen weet ik niet hoe ?
daarom ook dat ik hierbij hulp vraag hoe ik dat kan doen
 
Als jij niet weet waar je de voor- en achternaam vandaan moet halen weten wij dat uiteraard ook niet. Of staan die soms ergens in oMail.Sender, oMail.To of in sName?
 
Laatst bewerkt:
Ik weet wel hoe ik aan de voor en achternaam komt dat is gewoon met = oMail.sender

Maar dan krijg ik zoals ik ook bovenaan laat lezen "piet jansen of klaas bakker"
Nou probeer met deze oMail.sender een oplossing te zoeken dat ik daar PJA of KBA van kan maken
Dus de 1e letter van de voornaam en 2 letters van de achternaam

Echter ik kom maar tot zover
oMail.sender = Piet Jansen
Firstname = Mid(oMail.Sender, 1, 1)
Lastname = ???

Hoe kom ik nu bij de 2 letters van Jansen
En niet Mid(oMail.sender, 5,2) dat klopt dat is JA
en daar kan ik dan PJA van maken maar als ik Klaas Bakker heb dan werkt dat natuurlijk niet meer.

Vandaar mijn vraag ????
 
Dat is wat duidelijker :)
Plaats deze functie in een module:
Code:
Function NaamAfkorting(P1 As String) As String
    Dim i As Integer
    For i = Len(P1) To 1 Step -1
        If Mid(P1, i, 1) = " " Then
            NaamAfkorting = UCase(Left(P1, 1) & Mid(P1, i + 1, 2))
            Exit For
        End If
    Next i
End Function

Op de plek waar het moet komen plaats je dan dit:
=NaamAfkorting(oMail.Sender)
 
Laatst bewerkt:
Kan je mij misschien helpen hoe ik dat precies kan doen
Ik kom er namelijk niet uit en krijg een foutmelding ?

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

Function NaamAfkorting(P1 As String) As String
For i = Len(P1) To 1 Step -1
If Mid(P1, i, 1) = " " Then
NaamAfkorting = UCase(Left(P1, 1) & Mid(P1, i + 1, 2))
Exit For
End If
Next i
End Function
 
3 dingen:
Plaats je code eens tussen code tags zoals ik deed.
Als je zegt een foutmelding te krijgen, vertel er dan bij welke melding dat is.
Heb je die code in een module gezet of ergens anders?
 
Ik heb de Functie er onder geplaatst (Blauw) en de afkorting geplaats waar hij zou moeten zijn(Rood)

Code:
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) & "_" & [COLOR="#FF0000"]NaamAfkorting(oMail.Sender)[/COLOR] & "-" & 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 

[COLOR="#0000FF"]Function NaamAfkorting(P1 As String) As String
 For i = Len(P1) To 1 Step -1
 If Mid(P1, i, 1) = " " Then
 NaamAfkorting = UCase(Left(P1, 1) & Mid(P1, i + 1, 2))
 Exit For
 End If
 Next i
 End Function[/COLOR]
 
Dat is de vraag niet. Nu weet ik nog niet of de code in een module staat of ergens anders en ook heb je nog niet verteld wat de foutmelding is.
 
De functie kan een stuk korter (en sneller daardoor). En dat niet alleen: hij is ook een stuk flexibeler, want wat doe je met samengestelde namen? Mark Harinxma thoe Slooten bijvoorbeeld? In dat geval zou de code MHA moeten zijn, niet MSL. Door met Split te werken, kun je uitzonderingen inbouwen, en zelfs controleren op tussenvoegsels.
Code:
Function NaamAfkorting(P1 As String) As String
Dim tmp As Variant
    tmp = Split(P1, " ")
    NaamAfkorting = UCase(Left(tmp(LBound(tmp)), 1) & Left(tmp(UBound(tmp)), 2))
End Function
 
Beide functies geven hetzelfde resultaat. Maar die van jou is netter :)
 
Nu nog wel, want ik heb verder geen constructies gemaakt op dubbele namen. Weet natuurlijk ook niet of dat nodig is. Maar waar blijft die foutmelding? Volgens mij zou het gewoon moeten werken namelijk. Hij levert netjes een string terug tenslotte :)
 
Je kunt dit nog proberen, als je vermoedt dat het probleem in de afkorting zit:
Code:
enviro = VBA.Environ("USERPROFILE")
[B]sAfk = NaamAfkorting(oMail.Sender)
[/B]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) & "_" & [B]sAfk[/B] & "-" & oMail.To & "_" & sName & ".msg"
    sPath = "d:\user\Desktop\Inbox\"
 
En op welke regel en in welke Sub of Function?
En nogmaals de vraag, staat die Function in een module of niet?
Als mijn vragen te ingewikkeld zijn, laat dan even weten wat er niet duidelijk is.
 
Ik had Naamafkoting ook nog een keer bovenin geplaatst en daarom kreeg ik een foutmelding
Nu werkt hij prima

Dank je wel het werkt perfect mijn dank is groot is aan jullie beiden Edmoor en Octafish
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan