1

I have some VBA that i use to download all the attachments from an email and save them to a directory.

This is causing me some problems because the handle from Outlook is remaining on the folder and as a result it fails to delete correctly.

I thought my code is pretty fool proof and shouldn't be keeping a hold on the folder after the completion of the script.

Can someone please point out to me what I have done wrong :/

Sub SaveCustDetails(myItem As Outlook.MailItem)

'On Error Resume Next

Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myAttachment As Outlook.Attachment
Dim I As Long

Dim strBranch As String
Dim strPolRef As String
Dim strBody As String
Dim strBrLoc As Integer
Dim strPrLoc As Integer
Dim strFolderName As String

Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = myOlapp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
'Set myFolder = myFolder.Folders("Crash Alerts")

'Places the Body in a string
strBody = myItem.Body

'Finds the Branch Number
strBrLoc = InStr(1, strBody, "Branch:")
strBranch = Mid(strBody, strBrLoc + 8, 1)

'Finds the Policy Reference
strPrLoc = InStr(1, strBody, "Reference:")
strPolRef = Mid(strBody, strPrLoc + 11, 10)

'Concatenate The Branch Number and PolRef
strFolderName = strBranch & "-" & strPolRef

    If myItem.Attachments.Count <> 0 Then

        For Each myAttachment In myItem.Attachments

            strAttachmentName = myAttachment.DisplayName

            strFindOBracket = InStr(4, strAttachmentName, "(") 'Finds the Bracket

            If strFindOBracket <> 0 Then
            strAttachment = Trim(Mid(strAttachmentName, 1, strFindOBracket - 1)) & ".pdf"
            Else
            strAttachment = myAttachment.DisplayName
            End If

            FilePath = "C:\Processing\HTML Email\" & strFolderName & "\"

            If Len(Dir(FilePath, vbDirectory)) = 0 Then
            MkDir FilePath
            End If

            If strAttachment = "Covernote.pdf" Then
            myAttachment.SaveAsFile FilePath & "Covernote1.pdf"
            Else
            myAttachment.SaveAsFile FilePath & strAttachment
            End If
            I = I + 1

        Next
    End If

'Next

Set myOlapp = Nothing
Set myNameSpace = Nothing
Set myFolder = Nothing
Set myAttachment = Nothing
Set myItem = Nothing

End Sub
4

1 回答 1

1

在 Siddharth 的出色帮助和指导之后，我自己回答了这个问题，Outlook 没有保留目录。

该目录本身是一个幽灵目录，在删除时仍然存在。这导致我的循环机制崩溃。解决方案是 Siddharth 提供给我的代码：

On Error Resume Next
Kill FilePath & "*.*"
DoEvents
On Error GoTo 0

RmDir FilePath   
DoEvents

'This line then polls explorer again to confirm the deletion and 
'removes the ghost folder.
Debug.Print Len(Dir(FilePath, vbDirectory))

再一次，悉达多提供的帮助非常棒，我会为他能提供的任何帮助竖起大拇指。

于 2013-11-14T12:59:37.840 回答