Solved

A question to stefri to debug the code given

Posted on 2004-04-08
16
258 Views
Last Modified: 2012-05-04
Dear Mr. Stefri,

I'm getting some wron answers from this code, can you please help me debug them as we started together this problem i'm asking you to help me again

I tried to refresh the code but still I 'm not getting correct answers for the message boxes given in the last
I only got the correct answer for start time

Can you please help me to de bug this

Option Explicit
Sub itemsAdded(Item As Outlook.MailItem) ' 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 Date
Dim EndTime As Date
Dim Ticket As Integer
Dim iend As Integer
Dim itick As Integer
Dim Reason As String
Dim reasonstr 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
    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)
                MsgBox istart
                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)
                MsgBox iend
                If iend > 0 Then
                EndTime = Mid(theBody, iend + Len(EndTime), 14)
                End If
                itick = InStr(1, theBody, ticketstr, 1)
                If itick > 0 Then
                Ticket = Mid(theBody, iend + Len(ticketstr), 5)
                End If
               
                ireas = InStr(1, theBody, reasonstr, 1)
                If itick > 0 Then
                Reason = Mid(theBody, iend + Len(reasonstr), 20)
                End If
               
                iloc = InStr(1, theBody, locstr, 1)
                If itick > 0 Then
                Location = Mid(theBody, iend + Len(locstr), 12)
                End If
                               
                MsgBox StartTime
                MsgBox EndTime
                MsgBox Ticket
                MsgBox Reason
                MsgBox Location
               

            End If
        End If
    End If
End Sub
0
Comment
Question by:LakshmanaRavula
  • 8
  • 7
16 Comments
 
LVL 5

Expert Comment

by:GMsb
ID: 10788379
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 :)
0
 

Author Comment

by:LakshmanaRavula
ID: 10791423
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"
0
 

Author Comment

by:LakshmanaRavula
ID: 10791439
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
0
 
LVL 13

Expert Comment

by:stefri
ID: 10792940
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

0
 
LVL 13

Expert Comment

by:stefri
ID: 10792957
Opps
read
Sub itemsAdded(Item As Outlook.MailItem) ' THIS IS THE TRICKY PART
instead of Sub itemsAdded() ' THIS IS THE TRICKY PART

Stefri
0
 

Author Comment

by:LakshmanaRavula
ID: 10793200
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
0
 
LVL 13

Expert Comment

by:stefri
ID: 10793370
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
0
 

Author Comment

by:LakshmanaRavula
ID: 10793546
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
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 13

Expert Comment

by:stefri
ID: 10794162
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

0
 

Author Comment

by:LakshmanaRavula
ID: 10794267
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
0
 
LVL 13

Expert Comment

by:stefri
ID: 10794276
Could you repost your code
Stefri
0
 

Author Comment

by:LakshmanaRavula
ID: 10794304
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
0
 
LVL 13

Accepted Solution

by:
stefri earned 500 total points
ID: 10794347
iend is not initialized

replace
                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

by

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))
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)))
      endDateTime = CDate(Trim(Left(endTime, Len(endTime) - 3)))
End If

stefri
0
 

Author Comment

by:LakshmanaRavula
ID: 10794448
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
0
 
LVL 13

Expert Comment

by:stefri
ID: 10794521
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
0
 

Author Comment

by:LakshmanaRavula
ID: 10794577
No problem
i just thought of informing you while i posted my question in EE
Thank You
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Create high volume marketing opportunities using email signatures with these top 10 DOs and DON'Ts of email signature marketing.
If you don't know how to downgrade, my instructions below should be helpful.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now