Outlook - garip item.Attachments hatası

Aşağıdaki e-postaya sahibim, bu e-postaya eklenmiş belirli bir Excel dosyasını kaydetmelidir. Kod, belirli bir konuyu içeren bir e-posta alındığında bu komut dosyasını tetikleyen bir kuralla birleştirilir. Kod tetiklenir, ancak burada son zamanlarda gördüğüm en garip hata geliyor: itm.Attachments.Count sıfır gibi görünüyor ve açıkçası dosya kaydedilmedi! Ama ... "Her biri ..." satırına bir kesme noktası koyarsam ve onu izlerim.Attachments.Count penceresini izlerseniz, sıfır olarak gösterilir. Yalnızca onu eklersem, sonra Ekler özelliğine göz atın, sonra Sayı özelliğine göre Sayı için 1 gösterilir (olması gerektiği gibi) ve kod iyi yürütülür. Neler olduğunu anlamaya çalışırken yarım günümü geçirdim, ancak çözemiyorum.

Davranış, hem Windows 7 x64'te Outlook 2010 x64'te hem de Windows 7 x86'da Outlook 2010 x86'da aynıdır. Makrolar Güven Merkezi'nde etkindir. Bazı ekran görüntüsünü kod ve kural ayarlarıyla ve aynı zamanda gözetleme pencerelerinin tuhaflığını gösteren bir film ekledim.

Senaryo bir süre önce inşa edildi, birkaç bilgisayarda iyi çalıştı ve buradaki adımlara dayanıyordu: iterrors.com/outlook-automatically-save-an-outlook-attachment-to-disk/. Herhangi bir fikir?

Adrian

Burada kural ekranı: https://drive.google.com/file/d/0Bw-aVIPSg4hsRFgxdzFtd3l1SkE/view?usp=sharing

1 dakika. film burada: https://drive.google.com/file/d/0Bw-aVIPSg4hsZERQWUJHLXd4bjA/view?usp=sharing

Public Sub Kona(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    saveFolder = "C:\test"
    For Each objAtt In itm.Attachments
        If InStr(objAtt.DisplayName, "Kona Preferred Fixed Price Matrix (ALL)") Then
            objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
        End If
        Set objAtt = Nothing
    Next
End Sub

Bu soruna bir çözüm bulmak için interneti araştırdım ve henüz kimse bir çözüm önermedi. İşte geldiğim şey:

Sorun: IMAP Türü Outlook E-posta Hesapları, ilk geldiklerinde Vücutlarını ve Eklerini indirmiyor. Her yerdeki Outlook uzmanları, bunu Outlook Gelişmiş Ayarlarında ayarlayabileceğinizi size söyleyecektir;

1. Çözüm: POP3'e geçin. Bir programlama açısından, bu sorunu çözer, ancak benim düşüncem IMAP ile yapamıyorsanız, o zaman yanlış yapıyorsunuz, değil mi?

2. Çözüm: Bunun kaba bir güç olduğuna dikkat edin, ancak işi halleder. ThisOutlookSession'da:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
  Dim objOutlook As Object
  Dim objNameSpace As Object

  Set objOutlook = Outlook.Application
  Set objNameSpace = objOutlook.GetNamespace("MAPI")

  'I am using this code on my gmail
  Set Items = objNameSpace.Folders("mathern29@gmail.com").Folders("Inbox").Items
End Sub
Private Sub Items_ItemAdd(ByVal objItem As Object)
    Dim objExcel As Object
    Dim objMsg As Object
    Dim Atmt As Outlook.Attachment
    Dim Atmts As Outlook.Attachments
    Dim objFSO As Object
    Dim objFile As Object
    Dim strFilePath As String
    Dim strBody As String

    On Error GoTo ErrorHandler
    If TypeName(objItem) = "MailItem" Then
        Set objMsg = objItem
        If objMsg.DownloadState <> 1 Then
            objMsg.Display
            objMsg.Close (1)
            Set objMsg = Nothing
            DoEvents
            Sleep (1000) 'Need a pause or the loop runs to fast and kills Outlook
            RetryMailEvent objItem
        Else
            strBody = objMsg.Body

            Set Atmts = objMsg.Attachments

            For Each Atmt In Atmts
                If Right$(Atmt.FileName, 3) = "txt" Then
                    Set objFSO = CreateObject("Scripting.FileSystemObject")
                    strFilePath = "C:\temp\" & Format(objItem.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
                    Atmt.SaveAsFile strFilePath
                    Set objFile = objFSO.OpenTextFile(strFilePath, 1)
                    strBody = strBody & "[Attatchment] " & objFile.ReadAll & " [/Attatchment]"

                    objFile.Close
                    Kill strFilePath
                End If
            Next Atmt

            'Any additional Code you want to run goes here

        End If
    End If
ProgramExit:
    Set objMsg = Nothing
    Set objExcel = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

Ayrı bir modülde:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub RetryMailEvent(ByVal objItem As Object)
    Dim objExcel As Object
    Dim objMsg As Object
    Dim Atmt As Outlook.Attachment
    Dim Atmts As Outlook.Attachments
    Dim objFSO As Object
    Dim objFile As Object
    Dim strFilePath As String
    Dim strBody As String

    On Error GoTo ErrorHandler
    If TypeName(objItem) = "MailItem" Then
        Set objMsg = objItem
        If objMsg.DownloadState <> 1 Then
            Set objMsg = Nothing
            DoEvents
            Sleep (1000) 'Need a pause or the loop runs to fast and kills Outlook
            RetryMailEvent objItem
        Else
            strBody = objMsg.Body

            Set Atmts = objMsg.Attachments

            For Each Atmt In Atmts
                If Right$(Atmt.FileName, 3) = "txt" Then
                    Set objFSO = CreateObject("Scripting.FileSystemObject")
                    strFilePath = "C:\temp\" & Format(objItem.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
                    Atmt.SaveAsFile strFilePath
                    Set objFile = objFSO.OpenTextFile(strFilePath, 1)
                    strBody = strBody & "[Attatchment] " & objFile.ReadAll & " [/Attatchment]"

                    objFile.Close
                    Kill strFilePath
                End If
            Next Atmt

            'Any additional Code you want to run goes here

        End If
    End If
ProgramExit:
    Set objMsg = Nothing
    Set objExcel = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

Not: Yalnızca bu bulguları sizinle paylaşmak için StackExchange kullanıcısı oldum. Beğendiysen, lütfen devam et ve sorunlu diğer ruhları buraya benzer problemlerle bağla :).