A question to stefri to debug the code given

a sample mail you try to parse would be helpfull
But from first reading

 '14 is the length of 04/18/04  00:01
I count it more as 15
Change 14 to len("04/18/04  00:01") this way you'll know for sure the length :)

I'm sorry last night before going to bed i've posted the Question That is the reason I could respond immedietly

Now I'm getting all the vaues correctly except End date even I tried with your suggestion.

Instead of getting the date I'm getting "12.00 AM"

And when I'm trying to establish a connection with access

like

Dim adoConn As New ADODB.Connection

It is giving me an error user defined type not defined

LakshmanaRavula

Sorry for the value 14, I did not notice there were two spaces. I would suggest to keep as String for startTime and endTime to avoid VB interpretation of what MID function returns
Initialize the variable when entering the sub
StartTime =""
EndTime =""
Reason =""
reasonstr =""
Location=""

I noticed in the example you provided extra spaces (I replaced them with #° between colon and the dat/time value for

End Date & Time:###04/18/04  05:00 CDT  (04/18/04  10:00 GMT). I thought it was a typo

To avoid this:
endtime = Trim(Mid(theBody, iend + Len(endstr), InStr(iend + 1, theBody, "(", 1) - iend - Len(endstr)))
on the line above, endTime would be: 04/18/04  05:00 CDT
Apply the same method to startTime
startTime=Trim(Mid(theBody, istart+ Len(startStr), InStr(istart+ 1, theBody, "(", 1) - istart- Len(startStr)))

You are computing itick but do not use it in the following code lines!!!! Same for iloc, etc....

To get Reason, etc; you have to find what is the seapration character between the lines: it can be vbCrLf or vbLf
I modified your code to handle this
I removed the various tests:
   If Item.Class = olMail Then
        If Len(Item.Subject) > 0 Then
            If InStr(1, LCase(Item.Subject), mySubject, 1) <> 0 Then....
They are not ncessary as the rule fires on ly if this is a mail, the subject holds words...

The final code should be:


Option Explicit
Sub itemsAdded() ' THIS IS THE TRICKY PART

'Dim attach As Outlook.Attachment
  Dim mySubject As String
Dim istart As Integer
Dim startStr As String
Dim endStr As String
Dim ticketstr As String
Dim reasonstr As String
Dim locstr As String
Dim theBody As String
Dim strFile As String
Dim StartTime As String
Dim EndTime As String
Dim Ticket As Integer
Dim iend As Integer
Dim itick As Integer
Dim Reason As String

Dim Location As String

    startStr = "Start Date & Time:"
    endStr = "End Date & Time:"
    ticketstr = "PNMP Ticket:"
    reasonstr = "Reason for Maintenance:"
    locstr = "Locations:"
    mySubject = "test" ' MUST be in lowercase as Item.subject will be converted to lcase before comparison

    On Error Resume Next


                If Item.attchments.Count > 0 Then
                    For Each attach In Item.Attachments
                        strFile = attach.Filename
                        'Save attachment to specified directory
                        attach.SaveAsFile "C:\" & strFile
                    Next
               End If
               theBody = Item.Body
               
          istart = InStr(1, theBody, startStr, 1)
'                MsgBox istart
                If istart > 0 Then
                    StartTime = Trim(Mid(theBody, istart + Len(startStr), InStr(istart + 1, theBody, "(", 1) - istart - Len(startStr)))
                End If
                iend = InStr(1, theBody, endStr, 1)

                If iend > 0 Then
                    EndTime = Trim(Mid(theBody, iend + Len(endStr), InStr(iend + 1, theBody, "(", 1) - iend - Len(endStr)))
                End If
' Assuming vbCrLf is the separator between lines
'If no woking, try vbCr or vbLf
                itick = InStr(1, theBody, ticketstr, 1)
                If itick > 0 Then
                    Ticket = Trim(Mid(theBody, itick + Len(ticketstr), InStr(itick + 1, theBody, vbCrLf, 1) - itick - Len(ticketstr)))
                End If
               
                ireas = InStr(1, theBody, reasonstr, 1)
                If ireas > 0 Then
                    Reason = Trim(Mid(theBody, ireas + Len(reasonstr), InStr(ireas + 1, theBody, vbCrLf, 1) - ireas - Len(reasonstr)))
                End If
               
                iloc = InStr(1, theBody, locstr, 1)
                If iloc > 0 Then
                    Location = Trim(Mid(theBody, iloc + Len(locstr)))
                End If

End Sub

>>>>> Dim adoConn As New ADODB.Connection
You have to add a reference to Access in VBA editor: Tools/references
Browse to Microsoft Access 10 library, tick the box then OK

Stefri

Opps
read
Sub itemsAdded(Item As Outlook.MailItem) ' THIS IS THE TRICKY PART
instead of Sub itemsAdded() ' THIS IS THE TRICKY PART

Stefri

Thank You stefri

Actually after posting the code to you I made lot of modifications

Now i'm getting every thing Ok but The problem is only with the Formats of Start date and End date
The result format should be "04/18/04  05:00"

But for the start date I'm getting "4/18/2004" and for the end date I'm getting "12:00:00 AM"

this part has to be changed.

I tried pasting your code above but the dates were in text formats

the dates part I'm pasting here please go through and try to suggest some correction

theBody = Item.Body
               
                istart = InStr(1, theBody, startStr, 1)
                If istart > 0 Then
               
                StartTime = Mid(theBody, istart + Len(startStr), 14) '14 is the length of 04/18/04  00:01
                End If
                iend = InStr(1, theBody, endStr, 1)
                If iend > 0 Then
                EndTime = Mid(theBody, iend + Len(EndTime), Len("04/18/04  05:00"))
                End If

from my code
dim startTime as string
dim endTime as string
dim startDateTime as Date
dim endDateTime as Date

StartTime = Trim(Mid(theBody, istart + Len(startStr), InStr(istart + 1, theBody, "(", 1) -  istart - Len(startStr)))
startDateTime =cdate(left(startTime,len(startTime)-3)
EndTime = Trim(Mid(theBody, iend + Len(endStr), InStr(iend + 1, theBody, "(", 1) - iend - Len(endStr)))
endDateTime =cdate(left(startTime,len(EndTime )-3)
It Just removes the last three chars: CDT and convert to Date

stefri
Stefri

Stefri,
Now startdatetime is setted and coming out with the required format  "4/18/2004 12:01:00 AM"

But End datetime is still in the format of  "12:00:00 AM" and displaying the same

it means that the string you read is wrong
My fault...
startDateTime =cdate(trim(left(startTime,len(startTime)-3))
endDateTime =CDate(Trim(Left(EndTime, Len(EndTime) - 3)))

Missing also
Dim ireas As Integer
Dim iloc As Integer

stefri

ireas and iloc are not missing they are in the code. as I said to you I made lot of changes after posting.

But now after altering as per the suggestion did not made any difference in end date still it is showing "12:00:00 AM"

Strange situation

Could you repost your code
Stefri

Dim attach As Outlook.Attachment
 Dim mySubject As String
Dim istart As Integer
Dim startStr As String
Dim endStr As String
Dim ticketstr As String
Dim reasonstr As String
Dim locstr As String
Dim theBody As String
Dim strFile As String
Dim startTime As String
Dim endTime As String
Dim startDateTime As Date
Dim endDateTime As Date

Dim Ticket As Integer
Dim iend As Integer
Dim itick As Integer
Dim Reason As String
Dim Location As String
Dim ireas As Integer
Dim iloc As Integer

Dim TextStart As String
Dim TextEnd As String
Dim TextBody As String
TextStart = "CircuitID"
TextEnd = "Service Impact:"

    startStr = "Start Date & Time: "
    endStr = "End Date & Time:    "
    ticketstr = "PNMP Ticket: "
    reasonstr = "Reason for Maintenance:  "
    locstr = "Locations: "
    mySubject = "test" ' MUST be in lowercase as Item.subject will be converted to lcase before comparison
    MsgBox "Your mail matches"
    On Error Resume Next
    If Item.Class = olMail Then
        If Len(Item.Subject) > 0 Then
            If InStr(1, LCase(Item.Subject), mySubject, 1) <> 0 Then
                If Item.attchments.Count > 0 Then
                    For Each attach In Item.Attachments
                        strFile = attach.FileName
                        'Save attachment to specified directory
                        attach.SaveAsFile "C:\" & strFile
                    Next
                End If
                theBody = Item.Body
               
                istart = InStr(1, theBody, startStr, 1)
                If istart > 0 Then
               
                startTime = Trim(Mid(theBody, istart + Len(startStr), InStr(istart + 1, theBody, "(", 1) - istart - Len(startStr)))
                    startDateTime = CDate(Left(startTime, Len(startTime) - 3))
                endTime = Trim(Mid(theBody, iend + Len(endStr), InStr(iend + 1, theBody, "(", 1) - iend - Len(endStr)))
                    'endDateTime = CDate(Left(startTime, Len(endTime) - 3))
                    endDateTime = CDate(Trim(Left(endTime, Len(endTime) - 3)))

                End If
                itick = InStr(1, theBody, ticketstr, 1)
                If itick > 0 Then
                Ticket = Mid(theBody, itick + Len(ticketstr), Len("24421"))
                End If
               
                ireas = InStr(1, theBody, reasonstr, 1)
                If ireas > 0 Then
                Reason = Mid(theBody, ireas + Len(reasonstr), 71)
                End If
               
                iloc = InStr(1, theBody, locstr, 1)
                If iloc > 0 Then
                Location = Mid(theBody, iloc + Len(locstr), 30)
                End If
                'do the same for the other tags you are interested in
                ' process with access
                'StartTime = Mid(theBody, istart + Len(startStr), 14)
                'EndTime = Mid(theBody, iend + Len(EndTime), 14)

                MsgBox startDateTime
                MsgBox endDateTime
                MsgBox Ticket
                MsgBox Reason
                MsgBox Location
               

            End If
        End If
    End If
   
    istart = InStr(1, theBody, TextStart, 1)
    iend = InStr(1, theBody, TextEnd, 1)
    TextBody = Mid(theBody, istart, iend - Len(iend))
    MsgBox TextBody

Oh Wonderful

Working Great

Thank you very much.

By the way can you post your emai id to my email posted in the profile

I can't see your email id in your profile

Thank You once again

LakshmanaRavula
Happy it is working now,
about email address, I am sorry but I do not divulgate it
It is better for the community to share problems and solutions: evryone learns from the posts or get ideas from.

Stefri

No problem
i just thought of informing you while i posted my question in EE
Thank You