So, to make sure I understand. Are you saying you misspoke earlier and instead of reading "attachments," you actually meant you want to read the "body" of the email? Is that correct?Hi, sorry the body of the email stores all the details like .. Customer Name, contact number , Address etc... The data in the email is structured in table.
Okay, thanks for clarifying that part. Now, to my other question, are they using Outlook to read their email?Yes that's correct
Sub Extract()
On Error Resume Next
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Dim objFS As New Scripting.FileSystemObject
Dim objFile As Scripting.TextStream
'open the current folder
Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
For I = 1 To myfolder.Items.Count
Set myitem = myfolder.Items(I)
msgtext = myitem.Body
'search for specific text
delimtedMessage = Replace(msgtext, "Name", "###")
delimtedMessage = Replace(delimtedMessage, "Contact Number", "###")
delimtedMessage = Replace(delimtedMessage, "Address", "###")
delimtedMessage = Replace(delimtedMessage, "Email", "###")
delimtedMessage = Replace(delimtedMessage, "Gender", "###")
messageArray = Split(delimtedMessage, "###")
Set objFile = objFS.CreateTextFile("C:\ABC\a.txt", False)
With objFile
.Write messageArray(1) & "|" & messageArray(2) & "|"
.Write messageArray(3) & "|"
.Write messageArray(4) & "|"
.Write messageArray(5) & "|"
End With
Next
objFile.Close
End Sub
Sub Extract()
On Error Resume Next
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Dim objFS As New Scripting.FileSystemObject
Dim objFile As Scripting.TextStream
Dim FilePath As String
Dim sFilePath As String
Dim fileNumber As Integer
Dim strRowData As String
Dim strDelimiter As String
Dim j As Integer
strRowData = ""
Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
For I = 1 To myfolder.Items.Count
messageArray = ""
strRowData = ""
Set myitem = myfolder.Items(I)
msgtext = Trim(myitem.Body)
'search for specific text
delimtedMessage = Replace(Trim(msgtext), "Name", "###")
delimtedMessage = Replace(Trim(delimtedMessage), "Account Number", "###")
delimtedMessage = Replace(Trim(delimtedMessage), "Address", "###")
delimtedMessage = Replace(delimtedMessage, "Telephone Number", "###")
delimtedMessage = Replace(delimtedMessage, "DOB", "###")
delimtedMessage = Replace(delimtedMessage, "University", "###")
delimtedMessage = Replace(delimtedMessage, "SUbjects", "###")
delimtedMessage = Replace(delimtedMessage, "Birth Place", "###")
delimtedMessage = Replace(delimtedMessage, "SCore", "###")
delimtedMessage = Replace(delimtedMessage, "Outcome", "###")
delimtedMessage = Replace(delimtedMessage, "References", "###")
messageArray = Split(delimtedMessage, "###")
For j = 1 To 11
strRowData = Trim(strRowData & Trim(messageArray(j)) & "|")
Next j
MsgBox strRowData
sFilePath = "C:\a" & Format(Now, "ddmmyyyyhhmmss") & ".txt"
Set objFile = objFS.CreateTextFile(sFilePath, False)
With objFile
.WriteLine strRowData
End With
Next I
objFile.Close
End Sub
Sub Extract()
On Error Resume Next
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Dim objFS As New Scripting.FileSystemObject
Dim objFile As Scripting.TextStream
Dim FilePath As String
Dim sFilePath As String
Dim fileNumber As Integer
Dim strRowData As String
Dim strDelimiter As String
Dim j As Integer
strRowData = ""
Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
sFilePath = "C:\a" & Format(Now, "ddmmyyyyhhmmss") & ".txt"
For i = 1 To myfolder.Items.Count
messageArray = ""
strRowData = ""
Set myitem = myfolder.Items(i)
msgtext = Trim(myitem.Body)
'search for specific text
delimtedMessage = Replace(Trim(msgtext), "Name", "###")
delimtedMessage = Replace(Trim(delimtedMessage), "Account Number", "###")
delimtedMessage = Replace(Trim(delimtedMessage), "Address", "###")
delimtedMessage = Replace(delimtedMessage, "Telephone Number", "###")
delimtedMessage = Replace(delimtedMessage, "DOB", "###")
delimtedMessage = Replace(delimtedMessage, "University", "###")
delimtedMessage = Replace(delimtedMessage, "SUbjects", "###")
delimtedMessage = Replace(delimtedMessage, "Birth Place", "###")
delimtedMessage = Replace(delimtedMessage, "SCore", "###")
delimtedMessage = Replace(delimtedMessage, "Outcome", "###")
delimtedMessage = Replace(delimtedMessage, "References", "###")
messageArray = Split(delimtedMessage, "###")
For j = 1 To 11
strRowData = strRowData & Replace(Replace(Trim(strRowData & Trim(messageArray(j)) & "|"), vbCr, ""), vbLf, "")
Next j
MsgBox strRowData
If i = 1 Then
' create the file on first run
Set objFile = objFS.CreateTextFile(sFilePath, False)
Else
' open text file on succeeding files
Set objFile = objFS.OpenTextFile(sFilePath, ForAppending)
End If
With objFile
.WriteLine strRowData
End With
objFile.Close
Next i
End Sub
strRowData = Replace(Replace(Trim(strRowData & Trim(messageArray(j)) & "|"), vbCr, ""), vbLf, "")