Imports System.IO
Imports Microsoft.Office.Interop
'Tested on Visual Studion 2005 with .NET 2.0 - could work in Outlook macros as well

'CREATE A FORM AND PUT A BUTTON CALLED Button1 with the following for the Click event
Public Class Form1
  Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Dim folder As Outlook.Folder
    Dim i, j As Integer
    'K:\classes\2007\ecommerce GPEM\emails
    'Dim storeFolderS As String = "K:\\INFORMS" 'Folder to store the emails and their attachments
    Dim storeFolderS As String = "K:\\classes\\2007\\ecommerce GPEM\\emails" 'Folder to store the emails and their attachments
    Dim storeFile As String = storeFolderS & "\\abstracts.txt" 'File to store emails with a delimiter separating the fields
    Dim storeLine As String
    Dim attachName As String
    Dim dS As String = "+" 'tabs in emails can screw up the 

    folder = GetFolder("\\Personal Folders\Inbox\classes\ecomm2007") 'folder in outlook that we want to download from
    'folder = GetFolder("\\Personal Folders\Inbox\INFORMS RM 2007\Abstracts Acknowledged") 'folder in outlook that we want to download from
    Dim sw As System.IO.StreamWriter
    sw = My.Computer.FileSystem.OpenTextFileWriter(storeFile, False)
    If Not (folder Is Nothing) Then
      Dim items As Outlook.Items = folder.Items
      Dim mailItem As Outlook.MailItem = Nothing
      Dim folderItem As Object

      If My.Computer.FileSystem.DirectoryExists(storeFolderS) = False Then Directory.CreateDirectory(storeFolderS)
      'header
      storeLine = "index" & dS & "Name" & dS & "sendDate" & dS & "cc's" & dS & "sender Email" & dS & "message"
      sw.WriteLine(storeLine)
      i = 0
      For Each folderItem In items
        mailItem = TryCast(folderItem, Outlook.MailItem)
        If mailItem IsNot Nothing Then
          i = i + 1
          Dim mBody As String = mailItem.Body.Replace(Constants.vbLf, Constants.vbNullString)
          mBody = mBody.Replace(Constants.vbCr, Constants.vbNullString)
          mBody = mBody.Replace(dS, Constants.vbNullString)
          storeLine = Str(i) & dS & mailItem.SenderName & dS & mailItem.SentOn & dS & mailItem.CC & dS & mailItem.SenderEmailAddress & dS & mBody
          j = 0
          For Each ma As Outlook.Attachment In mailItem.Attachments
            attachName = CStr(i) & "_" & CStr(j) & "_" & ma.FileName
            storeLine = storeLine & dS & attachName
            ma.SaveAsFile(storeFolderS & "\\" & attachName)
          Next
          sw.WriteLine(storeLine)
        End If
        folderItem = items.FindNext()
      Next
    End If
    sw.Close()
  End Sub
  Function GetFolder(ByVal FolderPath As String) As Outlook.Folder
    Dim TestFolder As Outlook.Folder
    Dim FoldersArray As Object
    Dim i As Integer
    Dim s As New Outlook.Application

    On Error GoTo GetFolder_Error
    If FolderPath.Substring(0, 2) = "\\" Then
      FolderPath = FolderPath.Substring(2, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    TestFolder = s.Session.Folders.Item(FoldersArray(0))
    If Not TestFolder Is Nothing Then
      For i = 1 To UBound(FoldersArray, 1)
        Dim SubFolders As Outlook.Folders
        SubFolders = TestFolder.Folders
        TestFolder = SubFolders.item(FoldersArray(i))
        If TestFolder Is Nothing Then
          GetFolder = Nothing
        End If
      Next
    End If
    'Return the TestFolder
    GetFolder = TestFolder
    Exit Function

GetFolder_Error:
    GetFolder = Nothing
    Exit Function
  End Function
End Class