' to watch a folder in a non-default data file Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox) ' Use this for a folder in your default data file Set objNS = Application.GetNamespace("MAPI")
Private WithEvents objItems As Outlook.Items Public Sub ShowMessage(Item As Outlook.MailItem) If InStr(1, Item.Subject, "Tip") = 0 Then Exit Subįor a run a script rule, delete Private Sub objItems_ItemAdd(ByVal Item As Object) and all of the lines above it then use this as the macro name and create your rule.
Private Sub objItems_ItemAdd(ByVal Item As Object) If you use an if Statement, it should be the first line of the bjItems_ItemAdd macro. If you need to filter the messages that added to the spreadsheet you have two options: use an If statement to exit the macro or convert it to a Run a Rule script. Warning: If too many messages come in at one time, the macro could fail. This set of macros needs to go into ThisOutlookSession. With a few slight modifications, we can watch a folder for new messages and process new mail as it arrives. XlSheet.Columns("A:E").VerticalAlignment = xlTopĪutomate using an ItemAdd or Run a Script Macro XlSheet.Columns("A:E").EntireColumn.AutoFit XlSheet.Range("E" & rCount) = strColE ' recieved time XlSheet.Range("D" & rCount) = strColD ' sent to XlSheet.Range("C" & rCount) = strColC ' message body XlSheet.Range("B" & rCount) = strColB ' sender address XlSheet.Range("A" & rCount) = strColA ' sender name Set olEU = Ĭase OlAddressEntryUserType.olOutlookContactAddressEntryĬase OlAddressEntryUserType.olExchangeDistributionListAddressEntry Select Case Ĭase OlAddressEntryUserType.olExchangeUserAddressEntry ' if not using Exchange, this block can be removedĭim oEDL As Outlook.ExchangeDistributionList StrRecipients = Recipient.Address & " " & strRecipients Set Selection = currentExplorer.Selection Set currentExplorer = Application.ActiveExplorer 'Find the next empty line of the worksheet ' strPath = enviro & "\Documents\test.xlsx" 'the path of the workbook under the windows user account '# Open a specific workbook to input the data Set xlApp = CreateObject("Excel.Application") Set xlApp = GetObject(, "Excel.Application")Īpplication.StatusBar = "Please wait while Excel source is opened. The workbook code removes hyperlinked URLs from the messages (for easier reading in Excel).ĭim strColA, strColB, strColC, strColD, strColE As String In addition, it will create the workbook if it doesn't exist and add the columns headers if needed.Īn Excel version of this macro is available in a workbook template here or as a text file here. If you want to run the macro on all messages in the selected folder, use this file. Also added column names and adjusted the column widths. Updated Octoto create a new workbook (user will need to save it). Updated Novemto get all recipient addresses.
0 kommentar(er)
