Vba 为什么我有时会在Instr函数中得到错误5？

我有一个脚本，可以更改电子邮件的正文。我想删除特定字符串中“-”字符后面的所有内容

代码运行得很好，但有时我会在这一行中遇到这个错误5

为什么即使邮件的正文是正确的并且不应该产生错误，错误也只发生几次？多谢各位

aText = Left(aText, InStr(1, aText, "-") - 1)

---

如果

aText

没有“-”，您将得到

运行时错误5

错误，因此您应该将代码重写为

Option Explicit


     Private WithEvents Items As Outlook.Items
                Private Sub Application_Startup()
                Dim olApp As Outlook.Application
                Dim objNS As Outlook.NameSpace
                Set olApp = Outlook.Application
                Set objNS = olApp.GetNamespace("MAPI")
                ' default local Inbox
                Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("Test").Items
                End Sub
                Private Sub Items_ItemAdd(ByVal item As Object)

                 Dim Msg As Outlook.MailItem
                 If TypeName(item) = "MailItem" Then
                Set Msg = item
                ' ******************
    Dim patternRef As String
    Dim patternDemandeur As String
    Dim patternNumero As String
    Dim patternDescriptionPanne As String
    Dim patternAdresse As String
    Dim patternDomaine As String
    Dim patternStatut As String
    Dim patternMotifDemande As String


    item.UnRead = False

    patternRef = "Numéro de la demande[\r\n]+([^\r\n]+)"
    patternDemandeur = "Emetteur[\r\n]+([^\r\n]+)"
    patternNumero = "N° tel de l'émetteur de la demande[\r\n]+([^\r\n]+)"
    patternDescriptionPanne = "Commentaires initial[\r\n]+([^\r\n]+)"
    patternAdresse = "Localisation de la demande[\r\n]+([^\r\n]+)"
    patternDomaine = "Famille motif[\r\n]+([^\r\n]+)"
    patternStatut = "Statut[\r\n]+([^\r\n]+)"
    patternMotifDemande = "Motif de la demande[\r\n]+([^\r\n]+)"


' Creation des differentes variables récuperées dans l'émail de base        
    Dim sText As String 'Variable qui reprendra le corps de l'émail reçu.
    Dim xText As String 'Variable reférence de la demande.
    Dim yText As String 'Variable reférence du demandeur.
    Dim zText As String 'Variable reférence du numero de telephone.
    Dim dText As String 'Variable reférence de la description de la panne.
    Dim aText As String 'Variable reférence de l'adresse.
    Dim bText As String 'Variable reférence du domaine d'intervention.
    Dim cText As String 'Variable reférence du statut fournit par l'entreprise.
    Dim oText As String 'Variable reférence du motif de la demande.




    sText = Msg.Body ' affectation de la variable





    xText = TestRegExp(sText, patternRef, 0)
    yText = TestRegExp(sText, patternDemandeur, 0)
    zText = TestRegExp(sText, patternNumero, 0)
    dText = TestRegExp(sText, patternDescriptionPanne, 0)
    aText = TestRegExp(sText, patternAdresse, 0)
    aText = Left(aText, InStr(1, aText, "-") - 1) 'Permet de supprimer tout les charactères après le tiret. Garde dans le aText, du premier charactere au tiret -1 donc sans le tiret.
    oText = TestRegExp(sText, patternMotifDemande, 0)
    bText = TestRegExp(sText, patternDomaine, 1)
    cText = TestRegExp(sText, patternStatut, 0)



  Dim NewMail As MailItem ' nouvel email
    Dim obApp As Object
    Set obApp = Outlook.Application
    Set NewMail = obApp.CreateItem(olMailItem) 'ces 3 lignes creent le mail.



    With NewMail 'remplissage du mail
        .Subject = "Domain"

        .To = "email"

        .Body = "REF=" & xText & vbCrLf & "DOM=" & bText & vbCrLf & "OBJ=" & aText & vbCrLf & "DEMANDE D'INTERVENTION : " & oText & vbCrLf & dText & vbCrLf & "Appelant : " & yText & " / " & zText

        .Importance = olImportanceHigh



    End With


    NewMail.Send
                End If


                End Sub









Function TestRegExp(myString As String, pattern As String, casDomaine As Integer)

'Create objects.
    Dim objRegExp As RegExp
    Dim objMatch As Match
    Dim colMatches  As MatchCollection
    Dim RetStr As String
    Dim result As String
    Dim resultPrep As String


' Create a regular expression object.
    Set objRegExp = New RegExp

'Set the pattern by  the Pattern property.
    objRegExp.pattern = pattern

' Set Case Insensitivity.
    objRegExp.IgnoreCase = True

'Set global applicability.
    objRegExp.Global = True

'Test whether the String can be compared.
    If (objRegExp.Test(myString) = True) Then

'Get the matches.
        Set colMatches = objRegExp.Execute(myString)   ' Execute search.



        If (objRegExp.Test(myString) = True) Then

'Get the matches.
            Set colMatches = objRegExp.Execute(myString)   ' Execute search.

            For Each objMatch In colMatches   ' Iterate Matches collection.

                If casDomaine = 0 Then

                    result = objMatch.SubMatches(0)

                End If


                If casDomaine = 1 Then

'Idealement ne demander que si le texte contient un mot clé pour éviter les erreurs de typo. Resolu par utilisation de conditions, à tester avec Case

' Select Case objMatch.SubMatches(0)

                    If trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Faible")) Then
' "Electricité (C.Faible)"

                        result = "28"

                    ElseIf trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Fort")) Then
'  "Electricité (C.Fort)"

                        result = "27"

                    ElseIf trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Plomberie")) Or trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Sanitaire")) Then
' "Plomberie / Sanitaire" / essayer d'eviter de lancer 2 cases (FaT)
                        result = "30"


                    ElseIf trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Clim")) Or trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Chauf")) Or trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Ventil")) Then
' "Clim / Chauf / Ventil"
                        result = "24"


                    ElseIf trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Sécurité")) Or trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Incendie")) Then
' "Sécurité / Incendie"
                        result = "32"

                    Else
                        result = "3"
                    End If


                End If
            Next
        End If
    End If

    TestRegExp = result

 'Affichage de chaque resultat pour la phase test

    ' MsgBox result // Affiche resultat à chaque fois pour les phases de test.



End Function


Function trouverMotDomaine(domaine As String, motCle As String) As Boolean

    Dim intPos As Integer

    intPos = 0
    intPos = InStr(domaine, motCle)
    trouverMotDomaine = intPos > 0

End Function 

编辑

If InStr(1, aText, "-") Then
    aText = Left(aText, InStr(1, aText, "-") - 1)
End If

---

如果

aText

没有“-”，您将得到

运行时错误5

错误，因此您应该将代码重写为

Option Explicit


     Private WithEvents Items As Outlook.Items
                Private Sub Application_Startup()
                Dim olApp As Outlook.Application
                Dim objNS As Outlook.NameSpace
                Set olApp = Outlook.Application
                Set objNS = olApp.GetNamespace("MAPI")
                ' default local Inbox
                Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("Test").Items
                End Sub
                Private Sub Items_ItemAdd(ByVal item As Object)

                 Dim Msg As Outlook.MailItem
                 If TypeName(item) = "MailItem" Then
                Set Msg = item
                ' ******************
    Dim patternRef As String
    Dim patternDemandeur As String
    Dim patternNumero As String
    Dim patternDescriptionPanne As String
    Dim patternAdresse As String
    Dim patternDomaine As String
    Dim patternStatut As String
    Dim patternMotifDemande As String


    item.UnRead = False

    patternRef = "Numéro de la demande[\r\n]+([^\r\n]+)"
    patternDemandeur = "Emetteur[\r\n]+([^\r\n]+)"
    patternNumero = "N° tel de l'émetteur de la demande[\r\n]+([^\r\n]+)"
    patternDescriptionPanne = "Commentaires initial[\r\n]+([^\r\n]+)"
    patternAdresse = "Localisation de la demande[\r\n]+([^\r\n]+)"
    patternDomaine = "Famille motif[\r\n]+([^\r\n]+)"
    patternStatut = "Statut[\r\n]+([^\r\n]+)"
    patternMotifDemande = "Motif de la demande[\r\n]+([^\r\n]+)"


' Creation des differentes variables récuperées dans l'émail de base        
    Dim sText As String 'Variable qui reprendra le corps de l'émail reçu.
    Dim xText As String 'Variable reférence de la demande.
    Dim yText As String 'Variable reférence du demandeur.
    Dim zText As String 'Variable reférence du numero de telephone.
    Dim dText As String 'Variable reférence de la description de la panne.
    Dim aText As String 'Variable reférence de l'adresse.
    Dim bText As String 'Variable reférence du domaine d'intervention.
    Dim cText As String 'Variable reférence du statut fournit par l'entreprise.
    Dim oText As String 'Variable reférence du motif de la demande.




    sText = Msg.Body ' affectation de la variable





    xText = TestRegExp(sText, patternRef, 0)
    yText = TestRegExp(sText, patternDemandeur, 0)
    zText = TestRegExp(sText, patternNumero, 0)
    dText = TestRegExp(sText, patternDescriptionPanne, 0)
    aText = TestRegExp(sText, patternAdresse, 0)
    aText = Left(aText, InStr(1, aText, "-") - 1) 'Permet de supprimer tout les charactères après le tiret. Garde dans le aText, du premier charactere au tiret -1 donc sans le tiret.
    oText = TestRegExp(sText, patternMotifDemande, 0)
    bText = TestRegExp(sText, patternDomaine, 1)
    cText = TestRegExp(sText, patternStatut, 0)



  Dim NewMail As MailItem ' nouvel email
    Dim obApp As Object
    Set obApp = Outlook.Application
    Set NewMail = obApp.CreateItem(olMailItem) 'ces 3 lignes creent le mail.



    With NewMail 'remplissage du mail
        .Subject = "Domain"

        .To = "email"

        .Body = "REF=" & xText & vbCrLf & "DOM=" & bText & vbCrLf & "OBJ=" & aText & vbCrLf & "DEMANDE D'INTERVENTION : " & oText & vbCrLf & dText & vbCrLf & "Appelant : " & yText & " / " & zText

        .Importance = olImportanceHigh



    End With


    NewMail.Send
                End If


                End Sub









Function TestRegExp(myString As String, pattern As String, casDomaine As Integer)

'Create objects.
    Dim objRegExp As RegExp
    Dim objMatch As Match
    Dim colMatches  As MatchCollection
    Dim RetStr As String
    Dim result As String
    Dim resultPrep As String


' Create a regular expression object.
    Set objRegExp = New RegExp

'Set the pattern by  the Pattern property.
    objRegExp.pattern = pattern

' Set Case Insensitivity.
    objRegExp.IgnoreCase = True

'Set global applicability.
    objRegExp.Global = True

'Test whether the String can be compared.
    If (objRegExp.Test(myString) = True) Then

'Get the matches.
        Set colMatches = objRegExp.Execute(myString)   ' Execute search.



        If (objRegExp.Test(myString) = True) Then

'Get the matches.
            Set colMatches = objRegExp.Execute(myString)   ' Execute search.

            For Each objMatch In colMatches   ' Iterate Matches collection.

                If casDomaine = 0 Then

                    result = objMatch.SubMatches(0)

                End If


                If casDomaine = 1 Then

'Idealement ne demander que si le texte contient un mot clé pour éviter les erreurs de typo. Resolu par utilisation de conditions, à tester avec Case

' Select Case objMatch.SubMatches(0)

                    If trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Faible")) Then
' "Electricité (C.Faible)"

                        result = "28"

                    ElseIf trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Fort")) Then
'  "Electricité (C.Fort)"

                        result = "27"

                    ElseIf trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Plomberie")) Or trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Sanitaire")) Then
' "Plomberie / Sanitaire" / essayer d'eviter de lancer 2 cases (FaT)
                        result = "30"


                    ElseIf trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Clim")) Or trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Chauf")) Or trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Ventil")) Then
' "Clim / Chauf / Ventil"
                        result = "24"


                    ElseIf trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Sécurité")) Or trouverMotDomaine(LCase(objMatch.SubMatches(0)), LCase("Incendie")) Then
' "Sécurité / Incendie"
                        result = "32"

                    Else
                        result = "3"
                    End If


                End If
            Next
        End If
    End If

    TestRegExp = result

 'Affichage de chaque resultat pour la phase test

    ' MsgBox result // Affiche resultat à chaque fois pour les phases de test.



End Function


Function trouverMotDomaine(domaine As String, motCle As String) As Boolean

    Dim intPos As Integer

    intPos = 0
    intPos = InStr(domaine, motCle)
    trouverMotDomaine = intPos > 0

End Function 

编辑

If InStr(1, aText, "-") Then
    aText = Left(aText, InStr(1, aText, "-") - 1)
End If

---

很可能在

aText

字符串中找不到

-

，因此

Left（）

公式失败。在执行

Left（）

之前，请尝试此检查：

---

很可能在

aText

字符串中找不到

-

，因此

Left（）

公式失败。在执行

Left（）

之前，请尝试此检查：

---

我想了想，但奇怪的是“-”总是在那里，当我再次发送相同的电子邮件重新启动代码时，代码正常工作。不管怎样，我都会按照你的建议修改代码。如果你觉得

aText

总是有“-”，那么调试代码并在运行时检查

aText

的值。还要确保您在

aText

中正确存储了值，即您使用的是正确的对象，而不是

选择。text

我调试了代码，aText的值是正确的。我认为发送时，正文的格式可能有问题。当我将邮件传送给自己以重新启动脚本时，它工作得很好，而当它是其他人时，它就不工作了，并且会出现此错误。在这两种情况下，尸体是一样的。我可以私下寄给你吗？非常感谢您的时间，正如我所想：）您正在检查一个

连字符（-）

，而主体有一个

破折号（-）

；）我想了想，但奇怪的是“-”总是在那里，当我再次发送相同的电子邮件重新启动代码时，代码正常工作。不管怎样，我都会按照你的建议修改代码。如果你觉得

aText

总是有“-”，那么调试代码并在运行时检查

aText

的值。还要确保您在

aText

中正确存储了值，即您使用的是正确的对象，而不是

选择。text

我调试了代码，aText的值是正确的。我认为发送时，正文的格式可能有问题。当我将邮件传送给自己以重新启动脚本时，它工作得很好，而当它是其他人时，它就不工作了，并且会出现此错误。在这两种情况下，尸体是一样的。我可以私下寄给你吗？非常感谢您的时间，正如我所想：）您正在检查一个

连字符（-）

，而主体有一个

破折号（-）

；）