Question

此代码用于将Outlook 2010中所选项目的附件保存到“我的文档”中的文件夹。我使用上一次迭代

遇到了问题

Dim itm As Outlook.MailItem

我最好猜测为什么它不能保存附件是有一些日历邀请混合在一起，其中一些有附件。我修改了代码以尝试解决这个问题，并且已经获得了Next Without For Error。

Public Sub saveAttachtoDisk()
Dim objOL As Outlook.Application
Dim objItems As Outlook.Items
Dim objFolder As Outlook.MAPIFolder
Dim obj As Object
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim fso As Object
Dim oldName
Dim file As String
Dim DateFormat As String
Dim newName As String

Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
saveFolder = enviro & "\Documents\Attachments\"

Set objOL = Outlook.Application
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items

Set fso = CreateObject("Scripting.FileSystemObject")

For Each obj In objItems

    With obj
        For Each objAtt In itm.Attachments

            file = saveFolder & objAtt.DisplayName
            objAtt.SaveAsFile file

            'Get the file name
            Set oldName = fso.GetFile(file)
            x = 1
            Saved = False

            DateFormat = Format(oldName.DateLastModified, "yyyy-mm-dd ")
            newName = DateFormat & objAtt.DisplayName

            'See if file name  exists
            If FileExist(saveFolder & newName) = False Then
                oldName.Name = newName
                GoTo NextAttach
            End If

            'Need a new filename
            Count = InStrRev(newName, ".")
            FnName = Left(newName, Count - 1)
            fileext = Right(newName, Len(newName) - Count + 1)
            Do While Saved = False
                If FileExist(saveFolder & FnName & x & fileext) = False Then
                    oldName.Name = FnName & x & fileext
                    Saved = True
                Else
                    x = x + 1
                End If
            Loop

NextAttach:
Set objAtt = Nothing

Next
    Next

Set fso = Nothing

MsgBox "Done saving attachments"
End With
End Sub

Function FileExist(FilePath As String) As Boolean

Dim TestStr As String
Debug.Print FilePath
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'Determine if File exists
If TestStr = "" Then
    FileExist = False
Else
    FileExist = True
End If

End Function

Answer 1

逻辑是：

For Each obj In objItems
    With obj
        For Each objAtt In itm.Attachments

必须以相反的方式“关闭”：

        Next objAtt
    End With
Next obj

在代码中检查此序列并进行相应调整。

注意：虽然VB不再需要Next提及其循环变量，但这是一种很好的做法，可以帮助您更好地理解For循环。

修复下一个没有错误

1 个答案: