How to work on each item from draft folder of Outlook

BizBoy

Board Regular
Joined
Jul 26, 2012
Messages
118
Hi,

I am trying to edit below mentioned code.
Brief about below code.

This code will check each item which is open.
Open here means, user has manually clicked on e-mail for 'Reply' 'Reply to All' or 'Forward'.

Code will check all such open items from Outlook.
However, I want to edit this code for each item in 'Draft' folder.
Items in draft folder will not be open in Outlook but these will be saved in Draft.

I believe ' For Each oins In oApp.Inspectors' this line in below code takes each open item.
However I am not able to edit below code for each item in Draft folder.

How can change the line from For Each oins In oApp.Inspectors to For each item in Draft folder.

Can anyone please help me in this.
Apologies for not uploading sample workbook. Thanks for your time.

Help only if you get time.

Cross posted at

https://chandoo.org/forum/threads/how-to-work-on-each-item-from-draft-folder-of-outlook.37789/


Code:
Function onScreen()
    Dim osCounter As Integer
    Dim oApp As New Outlook.Application
    Dim oins As Outlook.Inspector
    Dim osStatussheetOBJ As Object
    Set osStatussheetOB = Nothing
    Set osStatussheetOB = ThisWorkbook.Worksheets("My Sheet")
    osStatussheetOB.UsedRange.Offset(1, 0).ClearContents
    oncounter = 0
    universalInc = 0
    For Each oins In oApp.Inspectors
        UniversalStringStatus = vbNullString
        universalInc = universalInc + 1
        '+Getting latest From, To and CC from draft
        Dim outlookApp
        Dim olNs As Outlook.Namespace
        Dim Fldr As Outlook.MAPIFolder
        Dim olMail As Variant
        Dim myTasks
        Dim sir() As String
        Set outlookApp = CreateObject("Outlook.Application")
        Set olNs = outlookApp.GetNamespace("MAPI")
        Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
        Set myTasks = Fldr.Items
        Dim SLine As Long
        Dim ELine As Long
        If (InStr(1, oins.CurrentItem.Body, "From: ", vbTextCompare) > 0) Then
            SLine = InStr(1, oins.CurrentItem.Body, "From: ", vbTextCompare)
        End If
        If (InStr(1, oins.CurrentItem.Body, "Subject: ", vbTextCompare) > 0) Then
            ELine = InStr(1, oins.CurrentItem.Body, "Subject: ", vbTextCompare)
        End If
        If SLine = 0 Then GoTo SkipThisEmail
        CheckAddSht.Range("A1").Value = Mid(oins.CurrentItem.Body, SLine, ELine - SLine)
        SLine = 0
        ELine = 0
        CheckAddSht.Select
        oins.CurrentItem.Display
        oins.CurrentItem.Save
        osCounter = osCounter + 1
        'Serial number of draft
        osStatussheetOB.Range("A" & osStatussheetOB.Range("A" & Application.Rows.Count).End(xlUp).Row + 1).Value = _
        osCounter
        'User name
        osStatussheetOB.Range("B" & osStatussheetOB.Range("A" & Application.Rows.Count).End(xlUp).Row).Value = _
        Application.UserName
        'C To
        osStatussheetOB.Range("C" & osStatussheetOB.Range("A" & Application.Rows.Count).End(xlUp).Row).Value = _
        oins.CurrentItem.To
        'D CC
        osStatussheetOB.Range("D" & osStatussheetOB.Range("A" & Application.Rows.Count).End(xlUp).Row).Value = _
        oins.CurrentItem.CC
        'E BCCC
        osStatussheetOB.Range("E" & osStatussheetOB.Range("A" & Application.Rows.Count).End(xlUp).Row).Value = _
        oins.CurrentItem.BCC
        'F Subject
        osStatussheetOB.Range("F" & osStatussheetOB.Range("A" & Application.Rows.Count).End(xlUp).Row).Value = _
        oins.CurrentItem.Subject
        'Format I column for time and date
        osStatussheetOB.Range("I" & osStatussheetOB.Range("A" & Application.Rows.Count).End(xlUp).Row).NumberFormat = _
        "mm/dd/yyyy hh:mm:ss AM/PM"
        'Will populate NOW in I Column
        osStatussheetOB.Range("I" & osStatussheetOB.Range("A" & Application.Rows.Count).End(xlUp).Row).Value = _
        Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM")
        osStatussheetOB.Activate
        osStatussheetOB.Columns.AutoFit
        osStatussheetOB.Rows.AutoFit
        strMessage = vbNullString
SkipThisEmail:
    Next
End Function
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

Forum statistics

Threads
1,224,521
Messages
6,179,284
Members
452,902
Latest member
Knuddeluff

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top