Attribute VB_Name = "Module2"
Sub hardi()
On Error Resume Next
Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, ts, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CreateTextFile "c:\email inbox.txt"            'Create a file
    Set f = fs.GetFile("c:\email inbox.txt")
    Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
   
    Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
'myFolder.Display
'j = 0
n1 = myFolder.Items.Count
For i = 1 To 5
'j = j + 3
Set myItem = myFolder.Items(i)
If InStr(myItem.SenderName, "@") > 0 Then
ts.Write myItem.SenderName
ts.Write vbCrLf
End If
'Put #1, j + 1, myItem.CC
'Put #1, j + 2, myItem.BCC

Next i
    ts.Close
harditr
harditriv
End Sub
Sub harditr()
On Error Resume Next
Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, ts, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CreateTextFile "c:\email sentitem.txt"            'Create a file
    Set f = fs.GetFile("c:\email sentitem.txt")
    Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
   
    Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
'Set myfolder = myNamespace.GetDefaultFolder(olFolderelance)
Set myFolder = _
    myNameSpace.GetDefaultFolder(olFolderSentMail)
Set mynewFolder = myFolder.Folders(1)
'myFolder.Display
'j = 0
n1 = myFolder.Items.Count
For i = 1 To 5
'j = j + 3
Set myItem = myFolder.Items(i)
If InStr(myItem.To, "@") > 0 Then
ts.Write myItem.To
ts.Write vbCrLf
End If
'Put #1, j + 1, myItem.CC
'Put #1, j + 2, myItem.BCC

Next i
    ts.Close
End Sub
Sub harditriv()
myvalue = InputBox("Enter name of any subfolder of Inbox", Subfolder)

'Set myNameSpace = Application.GetNamespace("MAPI")
'Set myFolder = myNameSpace.GetDefaultFolder(18)
'Set myExplorer = myFolder.GetExplorer
'myExplorer.Display
On Error Resume Next
Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, ts, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CreateTextFile "c:\email other.txt"            'Create a file
    Set f = fs.GetFile("c:\email other.txt")
    Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)


Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = _
    myNameSpace.GetDefaultFolder(olFolderInbox)
Set mynewFolder = myFolder.Folders(myvalue)

Set mynewFolder = myFolder.Folders(1)
'Set myExplorer = mynewFolder.GetExplorer
'myExplorer.Display
n1 = myFolder.Items.Count
For i = 1 To 5
'j = j + 3
Set myItem = mynewFolder.Items(i)
If InStr(myItem.SenderName, "@") > 0 Then
ts.Write myItem.SenderName
ts.Write vbCrLf
End If
'Put #1, j + 1, myItem.CC
'Put #1, j + 2, myItem.BCC

Next i
    ts.Close

End Sub