Sir help needs in this VBA, Currently, VBA export only inbox items to excel, can I extract all incoming outlook subfolder emails to excel only junk items will exclude.
Current Coding.
Option Explicit
Const xlUp As Long = -4162 'Set the enumeration for Excel's xlup
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
Dim Msg As Outlook.MailItem
Dim ExApp As Object
Dim ExWb As Object
Dim DirSenderName As String '<- added
Dim Attach As Attachment
Dim AttachFolder As String
Dim FileName As String
Dim EmailRow As Long
Dim AttachRow As Long
Dim AttachNum As Long
Dim FileNumb As Long
Dim ErrNumb As Long
Dim WkBkOpen As Boolean
If TypeName(Item) = "MailItem" Then
FileName = "c:\Working\Daily E-mail\works\Outlook_Email_Manager.xlsm"
If FileName = "" Then
MsgBox "Please add a full file name for your Excel application"
Exit Sub
End If
Current Coding.
Option Explicit
Const xlUp As Long = -4162 'Set the enumeration for Excel's xlup
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
Dim Msg As Outlook.MailItem
Dim ExApp As Object
Dim ExWb As Object
Dim DirSenderName As String '<- added
Dim Attach As Attachment
Dim AttachFolder As String
Dim FileName As String
Dim EmailRow As Long
Dim AttachRow As Long
Dim AttachNum As Long
Dim FileNumb As Long
Dim ErrNumb As Long
Dim WkBkOpen As Boolean
If TypeName(Item) = "MailItem" Then
FileName = "c:\Working\Daily E-mail\works\Outlook_Email_Manager.xlsm"
If FileName = "" Then
MsgBox "Please add a full file name for your Excel application"
Exit Sub
End If