Перспектива загрузки макроса вложений пропускает нечетный файл

Question

Я унаследовал фрагмент кода, который запускается из пользовательской формы в Outlook 2010. Код должен сохранять все прикрепленные файлы из выбранных сообщений электронной почты в общей папке и сохранять пользователям C водить машину.

Пользователи заверили меня (последние 3 года), что они должны «разогревать макрос» первым делом с утра. Говорят, что если они выберут 100 электронных писем, макрос будет игнорировать некоторые вложения. Однако, если они начинаются с 10 выбранных электронных писем, макрос будет работать. Затем они выбирают 20 в следующем прогоне и продолжают увеличиваться.

Мне удалось воспроизвести это один раз, но только один раз, и я не понимаю, почему.

Любой совет или общий опыт были бы очень оценены.

Sub DownloadFiles() 
Dim objFS As Object 
Dim objMsg As Outlook.MailItem 'Object 
Dim objAttachments As Outlook.Attachments 
Dim objSelection As Outlook.Selection 
Dim objFolder As Outlook.MAPIFolder 
Dim iLoop As Long 
Dim lAttCount As Long, lMessageCount As Long, lngCount As Long 
Dim iNameCount As Integer, bContinue As Boolean, lSelCount As Long 
Dim strFile As String, strFolderpath As String 
Dim lVerCount As Long, bVerNew As Boolean, strVFile As String 


'call FSO function to create the local folders if they do not exist 
Call TallyFolders 

lAttCount = 0 
lMessageCount = 0 
strFolderpath = "C:\MCSUploads\etally\" 

Set objSelection = Application.ActiveExplorer.Selection 
Set objFS = CreateObject("Scripting.FileSystemObject") 

For lSelCount = 1 To objSelection.Count 
    Set objAttachments = objSelection.Item(lSelCount).Attachments 
    lngCount = objAttachments.Count 

    If lngCount > 0 Then 

     For iLoop = lngCount To 1 Step -1 
      strFile = "No Attachment" 
      strFile = objAttachments.Item(iLoop).FileName 
      strFile = strFolderpath & strFile 

      If objFS.FileExists(strFile) Then 
       'append lSelCount to the filename (not extension) to ensure a unique name 
       bContinue = True 

       For iNameCount = Len(strFile) To 1 Step -1 
        If bContinue And (Mid(strFile, iNameCount, 1) = ".") Then 

         lVerCount = 1 
         bVerNew = False 

         Do Until bVerNew = True 
          strVFile = Left(strFile, iNameCount - 1) & CStr(lVerCount) & Right(strFile, Len(strFile) - iNameCount + 1) 
          If objFS.FileExists(strVFile) Then 
           lVerCount = lVerCount + 1 
          Else 
           bVerNew = True 
          End If 
         Loop 

         bContinue = False 
        End If 
       Next iNameCount 

       strFile = strVFile 
      End If 

      objAttachments.Item(iLoop).SaveAsFile strFile 
     Next iLoop 
    End If 
Next lSelCount 

FrmDownloadAttachments1.LblMsg.Visible = True 

ExitSub: 
Set objAttachments = Nothing 
Set objMsg = Nothing 
Set objSelection = Nothing 
End Sub 




Sub TallyFolders() 
Dim oFileSystem As Object 
Dim FolderRaw As String, FolderComplete As String, FolderProblem As String 


Set oFileSystem = CreateObject("Scripting.FileSystemObject") 
If Not oFileSystem.FolderExists("C:\MCSUploads") Then oFileSystem.CreateFolder ("C:\MCSUploads") 


FolderRaw = "C:\MCSUploads\etally\" 
FolderComplete = "C:\MCSUploads\etally\Completed\" 
FolderProblem = "C:\MCSUploads\etally\Problems\" 
If Not oFileSystem.FolderExists(FolderRaw) Then oFileSystem.CreateFolder (FolderRaw) 
If Not oFileSystem.FolderExists(FolderComplete) Then oFileSystem.CreateFolder (FolderComplete) 
If Not oFileSystem.FolderExists(FolderProblem) Then oFileSystem.CreateFolder (FolderProblem) 



FolderRaw = "C:\MCSUploads\LAR\" 
FolderComplete = "C:\MCSUploads\LAR\Completed\" 
FolderProblem = "C:\MCSUploads\LAR\Problems\" 
If Not oFileSystem.FolderExists(FolderRaw) Then oFileSystem.CreateFolder (FolderRaw) 
If Not oFileSystem.FolderExists(FolderComplete) Then oFileSystem.CreateFolder (FolderComplete) 
If Not oFileSystem.FolderExists(FolderProblem) Then oFileSystem.CreateFolder (FolderProblem) 


FolderRaw = "C:\MCSUploads\MAR\" 
FolderComplete = "C:\MCSUploads\MAR\Completed\" 
FolderProblem = "C:\MCSUploads\MAR\Problems\" 
If Not oFileSystem.FolderExists(FolderRaw) Then oFileSystem.CreateFolder (FolderRaw) 
If Not oFileSystem.FolderExists(FolderComplete) Then oFileSystem.CreateFolder (FolderComplete) 
If Not oFileSystem.FolderExists(FolderProblem) Then oFileSystem.CreateFolder (FolderProblem) 
End Sub 

Answer 1

Да, это очень возможно, если вы не дадите коду достаточно времени для сохранения вложений. Самое простое решение - добавить DoEvents после objAttachments.Item(iLoop).SaveAsFile strFile.

Другой способ - использовать DIR после этой строки, чтобы проверить, действительно ли файл сохранен.

Debug.Print DIR(strFile) 

Что-то вроде этого

Do While Dir(strFile) = "" 
    DoEvents 
Loop