修复下一个没有错误

此代码旨在将附件从Outlook 2010中的选定项目保存到我的文档中的文件夹。我遇到了一个问题，使用以前的迭代是修复下一个没有错误

Dim itm As Outlook.MailItem

我最好的猜测，为什么它没有保存附件是有一些日历邀请混合，其中一些有附件。我修改了代码来尝试解决这个问题，并且得到了Next Without For错误。

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

来源

2016-04-29 VeryBasicApplication

的逻辑是：

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

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

 Next objAtt 
    End With 
Next obj

检查该序列在代码并相应地调整。

注意：尽管VB并不要求（已经）Next提到了它的循环变量，但它是一个很好的练习，可以帮助您更好地理解For循环。

来源

2016-04-29 14:36:40

修复下一个没有错误

回答

相关问题