VBA Excel pour traiter et transférer des courriels Causer « Mémoire insuffisante » Erreur

Question

J'espère que quelqu'un peut Aide- je frappe la redoutable erreur « des ressources mémoire ou système » avec un code en cours d'exécution dans Excel et travailler avec Outlook; d'où provient l'erreur.

Brève description est-il parcoure une liste de courriels regardant dans le corps/sujet pour une référence. S'il le trouve, il transmet l'élément de courrier électronique avec la référence dans le sujet. MWE ci-dessous; Je ne suis pas très expérimenté dans la gestion des objets Outlook mais j'ai passé près de deux heures à essayer différentes choses sans aucune chance. Je ne peux pas utiliser la fonction GetTable() car elle n'inclut pas les données de texte Corps autant que je sais (travaillant this), sauf si vous pouvez ajouter des colonnes pour inclure le corps du texte?

Si je cours dans une session d'Outlook fraîchement ouvert avec seulement une douzaine d'articles, il n'est pas un problème, mais j'ai besoin de travailler sur des centaines d'e-mails dans une boisson gazeuse. Frapper ma tête contre un mur ici. Merci beaucoup d'avance!

Private Sub processMWE(ByVal oParent As Outlook.MAPIFolder) 
     Dim thisMail As Outlook.MailItem 
     Dim myItems As Outlook.Items 
     Dim emailindex As Integer 
     Dim folderpath As String 
     Dim refandType As Variant 
     Dim fwdItem 
     Set myItems = oParent.Items 
     folderpath = oParent.folderpath 

     'Starting at row 2 on the current sheet 
     i = 2 

     With myItems 
      'Data output to columns in Excel 
      For emailindex = 1 To .Count 
       Set thisMail = .Item(emailindex) 

       'i takes row value 
       Cells(i, 1).Value = folderpath 
       Cells(i, 2).Value = thisMail.Subject + " " + thisMail.Body 
       Cells(i, 3).Value = thisMail.SenderEmailAddress 
       Cells(i, 4).Value = thisMail.ReceivedTime 
       Cells(i, 6).Value = thisMail.Categories 

       'Reference from body/subject and a match type (integer) 
       refandType = extractInfo(Cells(i, 2)) 

       'This is the reference 
       Cells(i, 5).Value = refandType(0) 

       'And this is the match type. 
       Select Case refandType(1) 
       Case 1, 2 
        'do nothing 
       Case Else 
        'For these match types, fwd the message 
        Set fwdItem = thisMail.Forward 
        fwdItem.Recipients.Add "#####@###" 
        fwdItem.Subject = Cells(i, 5) & " - " & thisMail.Subject 
        fwdItem.Send 
        'Edit original message category label 
        thisMail.Categories = "Forwarded" 
        thisMail.Save 
        'Note in spreadsheet 
        Cells(i, 7).Value = "Forwarded" 
        End If 
       End Select 
       i = i + 1 
      Next 
     End With 
End Sub 

Modifier: Nouveau développement: non seulement il est toujours suspendu sur la même ligne de code (thisMail.Body), il est en train de faire pour des articles de courrier spécifiques ?! Si je lui donne un lot de l'un de ces messages de problème, il se bloque immédiatement. Cela pourrait-il être quelque chose à voir avec l'encodage de caractères ou la longueur du message? Quelque chose qui signifie thisMail.Body ne fonctionnera pas qui déclenche une erreur de ressources?

Answer 1

Raison du problème:

Vous créez des éléments sans les libérer de la mémoire -avec ces lignes-

 For emailindex = 1 To .Count 
      Set thisMail = .Item(emailindex) 

Solution

libérer les objets Une fois que vous avez terminé avec eux

End Select 
       i = i + 1 
Set thisMail = Nothing   
Next 
     End With 

explication langue commune

Dans ce scénario, pensez à VBA comme serveur, vous dites ce que vous allez donner quelques plats pour servir aux clients, vous donnez tous à lui, mais vous ne dites à les libérer à la table, à un moment donné, il ne sera pas en mesure de traiter les plus plats (« mémoire insuffisante »)