Attribute VB_Name = "Module6"
Sub extractdata()

Dim aObjNSMapi As NameSpace
Dim aObjMapiFold As MAPIFolder, targfolder As MAPIFolder
Dim recMail As MailItem
Dim myMail As MailItem
'Dim targfldername As String
Dim Messubj As String, Mesbody As String
Dim total As Integer
Dim fs As Object
Dim pth As String, fname As String
Dim alldat As Variant
Dim pl As Integer, pl1 As Integer

alldat = Array(Name, Address, City, State, phone, fax, Email, _
interest, howsoon, timecontact, howcontact, Comments)
findindex = Array("Name", "Address", "City", "State", "Phone", "Fax", "Email", _
"What best describes your current level of interest in the 4D ultrasound business", _
"How soon would you like to open your new business", "When is the best time to contact you", _
"How would you like for us to contact you", _
"Please use the space below for questions or comments you would like to send to us")
plindex = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)

'myMail.EntryID
Set aObjNSMapi = GetNamespace("MAPI")
Set aObjMapiFold = aObjNSMapi.GetDefaultFolder(olFolderInbox)
'Set aObjMapiFold = aObjNSMapi
Set targfolder = Outlook.Application.ActiveExplorer.CurrentFolder
'Set aObjNewMail = aObjMapiFold.items.GetFirst
Set fs = CreateObject("Scripting.FileSystemObject")
'total = aObjMapiFold.items.Count
total = targfolder.items.Count

'Setting up Excel
'Go to Excel, if Excel is not opoen then create new instance of Excel and make it VISIBLE
On Error Resume Next
Set xlapp = GetObject(, "excel.application") 'Grab Excel (assuming it's already opened)
If Err.Number = 429 Then
   Set xlapp = CreateObject("excel.application") '(Excel is not open, create a new instance of excel)
End If
'xlapp.Visible = True 'Make it VISIBLE!
xlapp.workbooks.Add ' Add new Workbook
'Set xlsheet = CreateObject("Excel.sheet")
'
'Set xlapp = xlsheet.Application
'xlapp.Visible = True

indexrow = 1

For j = total To 1 Step -1
    
    Set recMail = targfolder.items(j)
    If recMail.Class = olMail Then
    
        Messubj = recMail.Subject
        If InStr(Messubj, "Info Requested") <> 0 Then
            
            Mesbody = recMail.Body
            For i = 0 To 11
                plindex(i) = InStr(1, Mesbody, findindex(i))
            '    MsgBox (findindex(i) & ", " & plindex(i))
           Next
            
            For i = 0 To 10
                alldat(i) = Mid(Mesbody, plindex(i) + Len(findindex(i)) + 2, plindex(i + 1) - plindex(i) - Len(findindex(i)) - 2)
               ' MsgBox (findindex(i) & ", " & alldat(i))
                If i = 6 Then
                    pl = InStrRev(alldat(i), Chr(34))
                    alldat(i) = Right(alldat(i), Len(alldat(i)) - pl)
                End If
             '   MsgBox (findindex(i) & ", " & alldat(i))
                xlapp.cells(indexrow, i + 2).Value = alldat(i)
           Next
                alldat(11) = Mid(Mesbody, plindex(i) + Len(findindex(i)) + 2) ' plindex(i + 1) - plindex(i) - Len(findindex(i)) - 2)
                xlapp.cells(indexrow, 13).Value = alldat(11)
                xlapp.cells(indexrow, 1).Value = recMail.ReceivedTime
                indexrow = indexrow + 1
       
             
        End If
    End If
    xlapp.Visible = True
    xlapp.cells.WrapText = False
    xlapp.cells.EntireColumn.AutoFit
Next

End Sub