I am working on an automation requirement at work where by i need to achieve following output namely as below: -
[CODE STARTS]
Sub UnSubscribe()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olItem As MailItem
Dim i As Integer
Dim b As Integer
Dim olInbox As Outlook.MAPIFolder
Dim olFolder As Outlook.MAPIFolder
Dim lngcol As Long
Dim currentMail As MailItem
Dim smtpAddress As String
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olInbox = olNamespace.Folders("Mailbox - India").Folders("Inbox")
Sheets("Unsubscribe").Activate
i = 8
For Each olItem In olInbox.Items
Cells(i, 3) = olItem.Sender
Cells(i, 4) = olItem.Subject ' Subject
Dim RT_DT
Dim RT
RT_DT = Left(olItem.ReceivedTime, 10)
RT = Right(olItem.ReceivedTime, 4)
Cells(i, 5) = RT_DT ' Received
Cells(i, 6) = RT
Cells(i, 7) = olItem.ReceivedByName ' Recepient
Cells(i, 8) = olItem.UnRead ' Unread?
Cells(i, 9) = UCase(Environ("Username"))
Cells(i, 10) = Format(Now(), "DD-MM-YY")
i = i + 1
Next
end sub
[CODE ENDS]
I am seeking help from all experts out there to help code the above to achieve the 3 steps i have mentioned. I have attached the sample format file in which the entire data will be extracted and basis input (folder name) specificed in Column K of Sheet ("Mailbox - India") the outlook emails needs to be moved to the specified outlook folders.
▬▬▬▬▬▬▬▬▬ Mod edit : thread moved to appropriate forum !
- Read details of sender, email received date & time, email status [Read / Unread].
- The output from step 1 to be published in excel sheet says Sheet 1 in column C to Column F. Then In Column G a outlook folder Name is required to be manually inserted by user. This folder name is a sub folder within specific outlook mailbox say ("Mailbox - India"). This outlook folder has a folder named Associate-1 which is placed as Inbox >> Team >> Associate - 1.
- Basis folder name in Column G, Excel VBA to move the specific mail item to the mentioned sub folder.
[CODE STARTS]
Sub UnSubscribe()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olItem As MailItem
Dim i As Integer
Dim b As Integer
Dim olInbox As Outlook.MAPIFolder
Dim olFolder As Outlook.MAPIFolder
Dim lngcol As Long
Dim currentMail As MailItem
Dim smtpAddress As String
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olInbox = olNamespace.Folders("Mailbox - India").Folders("Inbox")
Sheets("Unsubscribe").Activate
i = 8
For Each olItem In olInbox.Items
Cells(i, 3) = olItem.Sender
Cells(i, 4) = olItem.Subject ' Subject
Dim RT_DT
Dim RT
RT_DT = Left(olItem.ReceivedTime, 10)
RT = Right(olItem.ReceivedTime, 4)
Cells(i, 5) = RT_DT ' Received
Cells(i, 6) = RT
Cells(i, 7) = olItem.ReceivedByName ' Recepient
Cells(i, 8) = olItem.UnRead ' Unread?
Cells(i, 9) = UCase(Environ("Username"))
Cells(i, 10) = Format(Now(), "DD-MM-YY")
i = i + 1
Next
end sub
[CODE ENDS]
I am seeking help from all experts out there to help code the above to achieve the 3 steps i have mentioned. I have attached the sample format file in which the entire data will be extracted and basis input (folder name) specificed in Column K of Sheet ("Mailbox - India") the outlook emails needs to be moved to the specified outlook folders.
▬▬▬▬▬▬▬▬▬ Mod edit : thread moved to appropriate forum !