VBA code voor selecteren karakters voor speciaal teken

Status
Niet open voor verdere reacties.

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:

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.
 
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.
Dat werkt toch prima? strToLeft laat echt alleen maar het eerste deel zien. Maar waar komt de N_20190821_M2907900_Onderwerp mail.msg vandaan?
 
Hallo OctaFish,

aha, dan zal ik iets verkeerd gedaan heb. zal die code nog eens testen. Dit deel moet ik dan nog inbouwen in mijn macro
die N_20190821_ is het resultaat en komt uit die langere code. Die N staat voor Naar en kan dus ook een V zijn, Van. Zodat we weten of het een verzonden mail of ontvangen mail is. De getallen zijn de datum.
Sorry, ik was hier niet duidelijk in mijn uitleg
 
En hoe moet die in je bestandsnaam worden gezet? Want dat haal ik ook niet uit je code.
Zo werkt-ie bij mij prima:
Code:
Function TestSplit(Woord As String) As String
    TestSplit = Split(Woord, "_")(0)
End Function
Code:
Sub SaveMailAsFile()
Dim xMail As Outlook.MailItem
Dim xObjItem As Object
Dim xDtDate As Date
Dim sName As String, xPath As String, xFileName As String, xStatus As String

    Set xMail = Application.ActiveExplorer.Selection.item(1)
    Set xfolder = CreateObject("Shell.Application").BrowseForFolder(0, "Selecteer de map waar je de mail wilt bewaren:", 0, strStartingFolder)
    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
    xDtDate = xMail.ReceivedTime
    sName = xStatus & "_" & Format(xDtDate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & "_" & TestSplit(xMail.Subject) & ".msg"
    xPath = xFileName + sName
    xMail.SaveAs xPath, olMSG
    MsgBox "Hallo " & Environ("username") & "," & vbNewLine & vbNewLine & "de email werd met succes opgeslagen.", vbInformation, "Gelukt!"
    
End Sub
 
Goede morgen OctaFish,

het is me uiteindelijk toch gelukt.
Bedankt voor je hulp.

Groetjes,

Stefan
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan