VBA Outlook Erreur d'exécution '438': l'objet ne prend pas en charge cette propriété ou cette méthode

Question

J'essaie d'exécuter cette commande en macro pour déplacer une pièce jointe d'un dossier de ma boîte de réception (appelée téléchargements de boîte à outils) dans un dossier mon bureau et renommer la pièce jointe.

Je reçois

Erreur d'exécution « 438 »: Cet objet ne gère pas cette propriété ou méthode

Sub OSP() 

Dim oOutlook As Outlook.Application 
Dim oNs As Outlook.NameSpace 'Main Outlook Today 
Dim oFldrSb As Outlook.MAPIFolder 'Sub Folder in Outlook Today 
Dim oFldrSbSb As Outlook.MAPIFolder 'Sub in Sub Folder 
Dim oFldrSbSbsb As Outlook.MAPIFolder 'Sub in Sub in Sub Folder 

Dim oMessage As Object 
Dim sPathName As String 
Dim oAttachment As Outlook.Attachment 
Dim Ictr As Integer 
Dim iAttachCnt As Integer 

sPathName = "H:\Desktop\Toolkit Downloads\" 'My Folder Path where to save attachments 

Set oOutlook = New Outlook.Application 
Set oNs = oOutlook.GetNamespace("MAPI") 
Set oFldrSb = oNs.Folders("Joe.Bloggs@test.co.uk") 
Set oFldrSbSb = oFldrSb.Folders("Inbox") 
Set oFldrSbSbsb = oFldrSbSb.Folders("Toolkit Downloads") 

For Each oMessage In oFldrSbSbsb.Items 

    With oMessage.Attachments 
     iAttachCnt = .Count 

     If iAttachCnt > 0 Then 
      For Ictr = 1 To iAttachCnt 
       .Item(Ictr).SaveAsFile sPathName _ 
       & .Item(Ictr).Parent 
      Next Ictr 
     End If 
    End With 

DoEvents 

Next oMessage 

SaveAttachments = True 

MsgBox "All Indepol Download files have been moved !!" & vbCrLf & vbCrLf & "It worked... Yahoo" 

End Sub 

Answer 1

Tout d'abord, il n'y a pas besoin de créer une nouvelle perspectives exemple d'application si vous exécutez la macro VBA dans outlook:

Set oOutlook = New Outlook.Application 

, utilisez plutôt la Application propriété disponible dans le module defualt.

La méthode SaveAsFile de la classe Attachment accepte une chaîne qui correspond à l'emplacement où enregistrer la pièce jointe. Assurez-vous qu'une chaîne est passée là.

En général, je suggère de déboguer le code ligne par ligne et de trouver quelle propriété ou méthode génère exactement une erreur. Vous pouvez trouver l'article Getting Started with VBA in Outlook 2010 utile.

Answer 2

Vous essayez d'utiliser l'objet MailItem en tant que chaîne dans la méthode SaveAsFile, ergo l'erreur.

Je devine que vous voulez inclure le sujet du courrier dans le nouveau nom de fichier:

.Item(Ictr).SaveAsFile sPathName _ 
    & .Item(Ictr).Parent.Subject 

Et si vous avez des multiples pièces jointes, j'ajouter le nom de fichier initial là:

.Item(Ictr).SaveAsFile sPathName _ 
    & .Item(Ictr).Parent.Subject 
    & .Item(Ictr).FileName 

---

code complet:

Sub OSP() 

Dim oOutlook As Outlook.Application 
Dim oNs As Outlook.NameSpace 'Main Outlook Today 
Dim oFldrSb As Outlook.MAPIFolder 'Sub Folder in Outlook Today 
Dim oFldrSbSb As Outlook.MAPIFolder 'Sub in Sub Folder 
Dim oFldrSbSbsb As Outlook.MAPIFolder 'Sub in Sub in Sub Folder 

Dim oMessage As Object 
Dim sPathName As String 
Dim oAttachment As Outlook.Attachment 
Dim Ictr As Integer 
Dim iAttachCnt As Integer 

sPathName = "H:\Desktop\Toolkit Downloads\" 'My Folder Path where to save attachments 

Set oOutlook = Application 
Set oNs = oOutlook.GetNamespace("MAPI") 
Set oFldrSb = oNs.Folders("Joe.Bloggs@test.co.uk") 
Set oFldrSbSb = oFldrSb.Folders("Inbox") 
Set oFldrSbSbsb = oFldrSbSb.Folders("Toolkit Downloads") 

For Each oMessage In oFldrSbSbsb.items 

    With oMessage.Attachments 
     iAttachCnt = .Count 

     If iAttachCnt > 0 Then 
      For Ictr = 1 To iAttachCnt 
       .Item(Ictr).SaveAsFile sPathName _ 
       & .Item(Ictr).Parent.Subject 
       & .Item(Ictr).FileName 
      Next Ictr 
     End If 
    End With 

DoEvents 

Next oMessage 

SaveAttachments = True 

MsgBox "All Indepol Download files have been moved !!" & vbCrLf & vbCrLf & "It worked... Yahoo" 

End Sub