aText = Left(aText, InStr(1, aText, "-") - 1)
我有一个更改电子邮件正文的脚本。我想删除特定字符串中"-"caracter 之后的所有内容。
代码效果很好，但有时我在这一行收到此错误 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[rn]+([^rn]+)"
patternDemandeur = "Emetteur[rn]+([^rn]+)"
patternNumero = "N° tel de l'émetteur de la demande[rn]+([^rn]+)"
patternDescriptionPanne = "Commentaires initial[rn]+([^rn]+)"
patternAdresse = "Localisation de la demande[rn]+([^rn]+)"
patternDomaine = "Famille motif[rn]+([^rn]+)"
patternStatut = "Statut[rn]+([^rn]+)"
patternMotifDemande = "Motif de la demande[rn]+([^rn]+)"
' 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
如果aText没有"-"，你会得到Runtime Error 5错误，因此你应该重写你的代码
If InStr(1, aText, "-") Then
aText = Left(aText, InStr(1, aText, "-") - 1)
End If
编辑
If InStr(1, aText, Chr(45)) Then
aText = Left(aText, InStr(1, aText, Chr(45)) - 1)
MsgBox "Found a Dash"
ElseIf InStr(1, aText, Chr(151)) Then
aText = Left(aText, InStr(1, aText, Chr(151)) - 1)
MsgBox "Found a Hyphen"
End If
很可能它在aText字符串中找不到-，因此Left()公式失败。在执行Left()之前，请尝试此检查：
If InStr(1, aText, "-") > 0 Then aText = Left(aText, InStr(1, aText, "-") - 1)