Recherche d'une chaîne dans un format spécifique

Question

J'ai le code ci-dessous pour télécharger automatiquement des courriels Outlook dans un répertoire local spécifique.

Je voudrais être plus précis en ce qui concerne le nom de fichier pour le courrier enregistré.

Je dois rechercher l'objet et/ou le corps de l'e-mail pour trouver une chaîne de texte au format AANNNNNNA, où A est une lettre et N est un nombre. Si trouvé, utilisez celui-ci à la place du corps du sujet dans le nom du fichier résultant, si aucun n'est présent, utilisez l'objet de l'e-mail.

Je n'arrive pas à comprendre comment rechercher le format ci-dessus.

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 

    For Each objItem In ActiveExplorer.Selection 
     If objItem.MessageClass = "IPM.Note" Then 

      Set oMail = objItem 

      sName = oMail.Subject 
      ReplaceCharsForFileName sName, "-" 

      dtDate = oMail.ReceivedTime 
      sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _ 
       vbUseSystem) & Format(dtDate, "-hhnnss", _ 
       vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg" 

      sPath = "C:\Users\XXXXXX\Desktop\Test\" 
      Debug.Print sPath & sName 
      oMail.SaveAs sPath & sName, olMSG 

     End If 
    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, ":", 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 

Answer 1

est ici une façon de le faire en analysant simplement la chaîne:

Public Function FindCode(sCode As String) As String 
    Dim sCheck As String 
    Dim nIndex As Integer 
    For nIndex = 1 To Len(sCode) - 8 
    sCheck = Mid$(sCode, nIndex, 9) 
    If IsNumeric(Mid$(sCheck, 3, 6)) And _ 
     Not IsNumeric(Mid$(sCheck, 1, 2)) And _ 
     Not IsNumeric(Mid$(sCheck, 9, 1)) Then 
     FindCode = sCheck 
     Exit Function 
    End If 
    Next 
    FindCode = "[not found]" 
End Function 

Answer 2

Regex pourrait être une option pour vous (https://docs.microsoft.com/en-us/dotnet/standard/base-types/regular-expression-language-quick-reference) mais étant donné la simplicité du modèle de recherche alors l'opérateur Like semble un choix évident (https://msdn.microsoft.com/VBA/Language-Reference-VBA/articles/like-operator).

Le seul inconvénient avec Like est qu'il ne retourne pas l'emplacement du match dans votre chaîne de recherche (il retourne juste True ou False), de sorte que vous auriez besoin pour itérer votre chaîne de recherche dans des lots de 9 caractères à trouver le match et le renvoyer.

Public Sub RunMe() 
    Dim str As String 
    Dim nme As String 


    str = "To whom it may concern, find this: AB123456C. Happy coding, Ambie" 
    nme = FindName(str) 
    If nme <> "" Then MsgBox nme 

End Sub 
Private Function FindName(searchText As String) As String 
    Const PTRN As String = "[A-Za-z][A-Za-z]######[A-Za-z]" 
    Dim txt As String 
    Dim i As Long 

    If Len(searchText) >= 9 Then 
     For i = 1 To Len(searchText) - 9 + 1 
      txt = Mid(searchText, i, 9) 
      If txt Like PTRN Then 
       FindName = txt 
       Exit Function 
      End If 
     Next 
    End If 

End Function