2015-01-22 1 views
0

Я пытался найти сценарий, который сохраняет вложения в папку в нашей сети из Outlook. У меня наконец-то есть что-то работающее, но похоже, что он не работает на моей второй системе, которая выглядит как Outlook 2010. Я не могу точно сказать, из-за этой разницы.Visual Basic скрипт, не работающий над правилом Outlook 2010

Кодекс:

Sub SaveAllAttachments(objItem As MailItem) 
    Dim objAttachments As Outlook.Attachments 
    Dim strName, strLocation As String 
    Dim dblCount, dblLoop As Double 

    strLocation = "C:\test\" 

    On Error GoTo ExitSub 
    If objItem.Class = olMail Then 
     Set objAttachments = objItem.Attachments 
     dblCount = objAttachments.Count 
     If dblCount <= 0 Then 
      GoTo 100 
     End If 
     For dblLoop = 1 To dblCount 
      strID = " from " & Format(Date, "mm-dd-yy")   'Append the Date 
      'strID = strID & " at " & Format(Time, "hh`mm AMPM") 'Append the Time 
      ' These lines are going to retrieve the name of the 
      ' attachment, attach the strID to it to insure it is 
      ' a unique name, and then insure that the file 
      ' extension is appended to the end of the file name. 
      strName = objAttachments.Item(dblLoop).Filename 'Get attachment name 
      strExt = Right$(strName, 4)      'Store file Extension 
      strName = Left$(strName, Len(strName) - 4)  'Remove file Extension 
      strName = strName & strID & strExt    'Reattach Extension 
      ' Tell the script where to save it and 
      ' what to call it 
      strName1 = strLocation & "PDF\" & strName     'Put it all together 
      strName2 = strLocation & "JPG\" & strName     'Put it all together 
      ' Save the attachment as a file. 
      objAttachments.Item(dblLoop).SaveAsFile strName1 
      objAttachments.Item(dblLoop).SaveAsFile strName2 
     Next dblLoop 
     objItem.Delete 
    End If 
100 
ExitSub: 
    Set objAttachments = Nothing 
    Set objOutlook = Nothing 
End Sub 
+0

'У меня наконец-то есть что-то работающее. Итак, выше код уже делает то, что вы хотите? Как вы называете sub? Я имею в виду, я не думаю, что вы можете называть это прямо из правила, так как ему нужен 1 аргумент * objItem *. – L42

+0

Комментарий Out Error GoTo ExitSub. Если есть ошибка, какая строка? Метод, используемый для strExt, strExt = Right $ (strName, 4), не будет работать для 4-символьных расширений. – niton

+0

@ L42 Элемент, обрабатываемый правилом, является объектом в коде RunAScript. – niton

ответ

0

Это не имеет значения, какую версию Перспективы вы используете в данный момент. Код должен работать корректно.

Возможные причины, почему он не работает:

  1. я предлагаю выбрать другое место для сохранения файлов. Для диска C: требуется привилегия администратора на последней ОС.
  2. Правило не запускается.
  3. Ошибка в скрипте. Попробуйте вызвать скрипт вручную из другого модуля VBA и посмотреть, что происходит под капотом. Вы получаете какие-либо ошибки в коде?