tonissteiner
Gebruiker
- Lid geworden
- 17 sep 2008
- Berichten
- 337
Hallo forum gebruikers,
Ik probeer een code samen te stellen om emails op te slaan. Binnen het bedrijf is er een afspraak dit op een bepaalde manier te doen.
Ik ben er al in geslaagd een deel van de code samen te stellen. Maar nu loop ik vast.
We slaan de emails op op een server. Op de server staan mappen met de projectnummer en naam. Daaronder submappen en in een van die submappen worden de mails bewaard.
In de bestandsnaam moet ook het nummer van het project komen.
Een mapnaam ziet er bijvoorbeeld als volgt uit:
M2907900_VGB_Constructie van tools
Het deel van de code die ik nodig heb zou dus de karakters voor de eerste underscore moeten selecteren.
Ik heb dit proberen doen met volgende code:
Aangezien er twee underscores in de naam staan werkt deze code niet.
Kan iemand me helpen met mijn probleem?
De code die ik momenteel al samengesteld heb is deze:
Wat ik beoog te komen zou er dus zo moeten uitzien:
N_20190821_M2907900_Onderwerp mail.msg
Alvast bedankt voor jullie hulp.
Ik probeer een code samen te stellen om emails op te slaan. Binnen het bedrijf is er een afspraak dit op een bepaalde manier te doen.
Ik ben er al in geslaagd een deel van de code samen te stellen. Maar nu loop ik vast.
We slaan de emails op op een server. Op de server staan mappen met de projectnummer en naam. Daaronder submappen en in een van die submappen worden de mails bewaard.
In de bestandsnaam moet ook het nummer van het project komen.
Een mapnaam ziet er bijvoorbeeld als volgt uit:
M2907900_VGB_Constructie van tools
Het deel van de code die ik nodig heb zou dus de karakters voor de eerste underscore moeten selecteren.
Ik heb dit proberen doen met volgende code:
Code:
strToLeft = Split(YourStringValue,"_")(0)
Aangezien er twee underscores in de naam staan werkt deze code niet.
Kan iemand me helpen met mijn probleem?
De code die ik momenteel al samengesteld heb is deze:
Code:
Sub SaveMailAsFile()
Dim xMail As Outlook.MailItem
Dim xObjItem As Object
Dim xPath As String
Dim xDtDate As Date
Dim sName As String
Dim xFileName As String
Dim xStatus As String
Set xMail = Application.ActiveExplorer.Selection.Item(1)
Set xShell = CreateObject("Shell.Application")
Set xfolder = xShell.BrowseForFolder(0, "Selecteer de map waar je de mail wilt bewaren:", 0, strStartingFolder)
'Debug.Print xfolder.Title
If Environ("username") = xMail.Sender Then
xStatus = "N"
Else
xStatus = "V"
End If
If Not TypeName(xfolder) = "Nothing" Then
Set xFolderItem = xfolder.self
xFileName = xFolderItem.Path & "\"
Else
xFileName = ""
Exit Sub
End If
sName = xMail.Subject
ReplaceCharsForFileName sName, "_"
xDtDate = xMail.ReceivedTime
sName = xStatus & "_" & Format(xDtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & "_" & sName & ".msg"
xPath = xFileName + sName
xMail.SaveAs xPath, olMSG
MsgBox "Hallo " & Environ("username") & "," _
& vbNewLine _
& vbNewLine _
& "de email werd met succes opgeslagen.", vbInformation, "Gelukt!"
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", "")
sName = Replace(sName, "?", "")
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
Wat ik beoog te komen zou er dus zo moeten uitzien:
N_20190821_M2907900_Onderwerp mail.msg
Alvast bedankt voor jullie hulp.