2014-04-23 4 views
1

J'ai construit un projet VBA qui vérifie la boîte de réception sur des e-mails spéciaux,
extrait la pièce jointe et enregistrer la pièce jointe sur le réseau.
tout cela se produit lorsque l'utilisateur clique sur un bouton.Outlook 2013 courrier entrant

Mon problème est maintenant que je veux automatiser cela.
donc j'ai essayé de réécrire le projet VBA mais
quand un email arrive je reçois toujours le message d'erreur
'Unzulässiger oder nicht ausreichend defnierter Verweis de

(tr. Une mauvaise ou pas de référence définie suffisante)

Je ne peux pas comprendre ce qu'il faut faire et donc je suis en train
pour obtenir une réponse ici.

vous joint vous trouverez le code qui est placé dans 'ThisOutlookSession'

Private WithEvents Items As Outlook.Items 
Private Sub Application_Startup() 

Dim objNs As Outlook.NameSpace 
Dim X As Integer 

Set objNs = GetNamespace("MAPI") 
Set Items = objNs.GetDefaultFolder(olFolderInbox).Items 
End Sub 

Private Sub Items_ItemAdd(ByVal Item As Object) 

Dim objNs As Outlook.NameSpace 
Dim strPath, strAuditPath, strSavPath, strFolderName As String 
Dim oAttachment As Outlook.Attachment 
Dim objTrash As Outlook.Folder 
Dim intAnlagen, intTotal, i As Integer 

Set objNs = GetNamespace("MAPI") 

On Error GoTo check_error 

If TypeOf Item Is Outlook.MailItem Then 
    Dim Msg As Outlook.MailItem 
    Set Msg = Item 

    If Msg.SenderEmailAddress = "[email protected]" Then 
     If Left(Msg.Subject, 8) = "QHST-Log" Then 

     strSavPath = "D:\Users\AS400_QHST_Logs\" 
     strPath = "T:\DOKUMENTE\AS400\QHST-Logs\" 
     strAuditPath = "D:\Dropbox\QHST-Log\" 

     strFolderName = Right(Msg.Subject, 4) 
      If Dir(strPath & strFolderName, vbDirectory) = vbNullString Then 'Prüfen ob Subfolder der Form JJJJ angelegt ist. 
       MkDir strPath & strFolderName 
       MkDir strAuditPath & strFolderName 
       MkDir strSavPath & strFolderName 
      End If 
      strPath = strPath & strFolderName & "\" 
      strAuditPath = strAuditPath & strFolderName & "\" 
      strSavPath = strSavPath & strFolderName & "\" 
      strFolderName = Mid(.Subject, 14, 2) 

      If Dir(strPath & strFolderName, vbDirectory) = vbNullString Then 
       MkDir strPath & strFolderName 
       MkDir strAuditPath & strFolderName 
       MkDir strSavPath & strFolderName 
      End If 
      strPath = strPath & strFolderName & "\" 
      strAuditPath = strAuditPath & strFolderName & "\" 
      strSavPath = strSavPath & strFolderName & "\" 

      intAnlagen = Msg.Attachments.Count 
      intTotal = intTotal + intAnlagen 
      'Debug.Print objNewMail & ": "; intanlagen 
      If intAnlagen > 0 Then 
       For i = 1 To intAnlagen 
        Set oAttachment = Msg.Attachments.Item(i) 
        oAttachment.SaveAsFile strPath & oAttachment.FileName 
        oAttachment.SaveAsFile strAuditPath & oAttachment.FileName 
       Next i 
      End If 
      Msg.UnRead = False 
      Msg.Delete 
     End If 
    End If 
End If 

check_error: 
Debug.Print Err.Number; Err.Description 
If Err.Number = 75 Then 
    Err.Clear 
    GoTo Back1: 
Else 
    Err.Raise Err.Number, Err.Description 
End If 

Err.Clear 
Resume Next 

End Sub 
+0

kein Deutsch je parle –

+0

Essayer de changer tous vos allemand vers l'anglais que l'anglais est plus fréquente donc plus de gens peuvent aider. Aussi dans le cas où vous ne l'avez pas fait, où se produit l'erreur? – Alex

+0

@ Alex - l'erreur se produit lorsqu'un nouveau message arrive à la déclaration: Private Sub Items_ItemAdd (ByVal Item As Object) – neurieser

Répondre

Questions connexes