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
kein Deutsch je parle –
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
@ Alex - l'erreur se produit lorsqu'un nouveau message arrive à la déclaration: Private Sub Items_ItemAdd (ByVal Item As Object) – neurieser