How to work on each item from draft folder of Outlook

[BizBoy]

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/

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