我想将邮件导出到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
如果没有参数olItem,代码将无法运行。
打开一个邮件项目,然后运行它,它将在列表中。
Option Explicit
Sub CopyToExcel_Test
Dim currItem as mailitem
Set currItem = ActiveInspector.currentitem
CopyToExcel currItem
ExitRoutine:
Set currItem = Nothing
End Sub