宏未显示在列表中

Question

我想将邮件导出到Excel。但是，当我尝试运行宏时，在列表中没有看到它。

我刚刚从http://www.slipstick.com/developer/vba-copy-outlook-email-excel-workbook复制了下面的代码

Option Explicit
Const xlUp As Long = -4162

Sub CopyToExcel(olItem As Outlook.MailItem)
   Dim xlApp As Object
   Dim xlWB As Object
   Dim xlSheet As Object
   Dim rCount As Long
   Dim bXStarted As Boolean
   Dim strPath As String

   Dim M1 As Object
   Dim M As Object
   Dim lgLastRow As Long 'specify the last data row

   lgLastRow = Range("A1048576").End(xlUp).Row 'Take Note: very useful!!

   enviro = CStr(Environ("username"))

   'the path of the workbook
   strPath = enviro & "C:\Desktop\Project\SR History File.xlsx"
   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 input the data
   Set xlWB = xlApp.Workbooks.Open(strPath)
   Set xlSheet = xlWB.Sheets("Sheet1")

   'Find the next empty line of the worksheet
    rCount = lgLastRow = Range("A1048576").End(xlUp).Row + 1

   xlSheet.Range("A" & rCount) = olItem.SentOn
   xlSheet.Range("B" & rCount) = olItem.SenderEmailAddress
   xlSheet.Range("C" & rCount) = olItem.Subject

   xlWB.Close 1
   If bXStarted Then
       xlApp.Quit
   End If
   Set M = Nothing
   Set M1 = Nothing
   Set Reg1 = Nothing
   Set xlApp = Nothing
   Set xlWB = Nothing
   Set xlSheet = Nothing
End Sub

Answer 1

如果没有参数olItem，代码将无法运行。

打开一个邮件项目，然后运行它，它将在列表中。

Option Explicit

Sub CopyToExcel_Test
    Dim currItem as mailitem
    Set currItem = ActiveInspector.currentitem

    CopyToExcel currItem

ExitRoutine:
    Set currItem = Nothing

End Sub