Как вызвать макрос VBA как скрипт в Outlook - PullRequest
Новая
       21

Как вызвать макрос VBA как скрипт в Outlook

0 голосов
/ 11 июня 2019

Я хочу создать правило для Outlook, которое может проверять и перемещать почту.У меня есть код VBA, он работает нормально, но я не могу назвать этот макрос как скрипт.

Часть кода: 

Option Explicit
Sub CheckAttachments(olItem As MailItem)
Const strPath As String = "C:\Users\PC2\Documents\Temp_attachs\"
Const strFindText As String = "Completed"
Dim strFilename As String
Dim olAttach As Attachment
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim bXStarted As Boolean
Dim bFound As Boolean
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myDestFolder = myInbox.Folders("Subfolder1")

 If olItem.Attachments.Count > 0 Then
     For Each olAttach In olItem.Attachments
         If Right(LCase(olAttach.FileName), 4) = "xlsx" Then
             strFilename = strPath & Format(olItem.ReceivedTime, "yyyymmdd-HHMMSS") & _
                           Chr(32) & olAttach.FileName
             olAttach.SaveAsFile strFilename
             On Error Resume Next
             Set xlApp = GetObject(, "Excel.Application")
             If Err <> 0 Then
                 Application.StatusBar = "Please wait while Excel source is opened ... "
                 Set xlApp = CreateObject("Excel.Application")
                 bXStarted = True
             End If
             On Error GoTo 0
             'Open the workbook to read the data
             Set xlWB = xlApp.workbooks.Open(strFilename)
             Set xlSheet = xlWB.sheets("Sheet1")

             If FindValue(strFindText, xlSheet) Then
                olItem.Move myDestFolder

                'MsgBox "Value found in " & strFilename
                 bFound = True
             End If
             xlWB.Close 0
             If bXStarted Then xlApp.Quit
             If Not bFound Then Kill strFilename


             'Exit For
         End If
     Next olAttach
 End If
End Sub

Есть функция также для FindValue ...

И я попытался: 

Sub callmacro(Item as Outlook.MailItem)
call ChcekAttachments
End SUB

И я получил сообщение об ошибке: Argument not optional

1 Ответ

1 голос
/ 11 июня 2019

Попробуй это. Вам нужно передать аргумент в Check sub - (olItem As MailItem) 

Sub callmacro(Item as Outlook.MailItem)
call CheckAttachments Item
End sub
...