如何在Outlook中将VBA宏作为脚本调用

时间:2019-06-11 13:12:00

标签: vba outlook

我想为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 个答案:

答案 0 :(得分:1)

尝试一下。您需要在Check子项中传递参数-(olItem作为MailItem)

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