Outlook.Exe在附件后保持句柄保存VB

时间:2013-11-14 10:24:08

标签: outlook outlook-vba

我有一些VBA用于从电子邮件下载所有附件并将其保存到目录。

这导致了一些问题,因为Outlook中的句柄仍然保留在文件夹中,因此无法正确删除。

我认为我的代码非常简单,不应该在脚本完成后保留文件夹。

有人可以指出我做错了什么:/

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

1 个答案:

答案 0 :(得分:1)

在Siddharth的精彩帮助和指导之后,我自己回答这个问题.Outlook没有坚持到目录。

目录本身是一个ghost目录,在删除时保留。这导致我的循环机制崩溃。解决方案是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))

Siddharth提供的帮助再次非常棒,我会赞扬他能提供的任何帮助。