none
VBScript Outlook Автоматическое сохранение вложений RRS feed

  • Вопрос

  •  Здравствуйте! Пытался реализовать данный скрипт. Компилятор выдает ошибку пустого блока. Может я не правильно делаю выбор последнего входящего письма?

    Private Sub Application_NewMail()
    Const WINDOW_HANDLE = 0
    Const NO_OPTIONS = 0
     
    Set FS = CreateObject("Scripting.FilesystemObject")
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder _
        (WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, "%USERPROFILE")
         
    On Error GoTo ErrorHandler
    ' Checks to see if user cancels the browse box without selecting a location
    Set objFolderItem = objFolder.Self
    On Error GoTo 0  ' Reset the error handler
     
    objPath = objFolderItem.path & "\"
    Dim Msg, Style, Help, Ctxt, Response, MyString, Title, Default, MyValue, MyBody, FileToSave, _
        Counter

      Dim mailItems As Items
      Dim mailmsg As MailItem
      
          Set mailItems = Application.session.GetDefaultFolder(olFolderInbox).Items
          Set mailmsg = mailItems.GetLast
          Set myItem = mailItems.GetLast
          Set myAttachments = mailmsg.Attachments 'Ошибка здесь<<<<<<<<
          
          
          
          
    ' Grab all attachments in the message
     
    Counter = mailItems.GetLast.Attachments.Count ' This defines the number of attachments in the message
     
    Do While Counter > 0
       FileToSave = objPath & myAttachments.Item(Counter).DisplayName
       If FS.FileExists(FileToSave) Then ' Check to see if file already exists
          Msg = myAttachments.Item(Counter).DisplayName & " already exists.  Do you want to overwrite?"
          ' Define message.
          Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define yes/no buttons to display
          Title = "Duplicate file"    ' Define title of message box
          Response = MsgBox(Msg, Style, Title, Help, Ctxt)
          If Response = vbNo Then    ' User chose No, so don't overwrite the file
             MsgBox "File NOT Saved"
             GoTo SkipFile
          End If
       End If
       myAttachments.Item(Counter).SaveAsFile FileToSave
       ' Update the body of the message with the path and filename of the saved file
       myItem.HTMLBody = myItem.HTMLBody & "    *** ATTACHMENT SAVED AS: " & FileToSave & Chr(13)
       MsgBox myAttachments.Item(Counter).DisplayName & " has been saved"  ' Feedback to the user!
       myAttachments.Remove Counter ' Delete the file from the message
    SkipFile:
       Counter = Counter - 1
    Loop
     
    Exit Sub
         
    ErrorHandler:
       Select Case Err.Number
          Case 91 ' Error #91 indicates that the user did not select a file path.  Cancel the script
             Exit Sub
          Case Else
             MsgBox Err.Number
       End Select
       Resume
     
    End Sub