' *** This is the program to save in the configurator emails sent/recieved
'     to/from customers that are in the configurator database


' Check to see if this email is from a customer in the configurator database
Private Function IsConfigCustomer(strEmail As String) As Integer
'On Error GoTo E
    Dim Conn As ADODB.Connection
    Set Conn = New ADODB.Connection
    MM_MyConn_STRING = "Provider=SQLOLEDB.1;User Id=sa;Initial Catalog=Products;Data Source=glacier2"
    Conn.ConnectionString = MM_MyConn_STRING
    Conn.Open
    If strEmail = "" Or InStr(UCase(strEmail), "@sportsmanager.us") <> 0 Then
        IsConfigCustomer = 0
        Conn.Close
        Exit Function
    End If
    Dim RecConfigCust As ADODB.Recordset
    Set RecConfigCust = New ADODB.Recordset
    RecConfigCust.Open "Select CustID From Login Where Email='" & strEmail & "' Or SecEmail='" & strEmail & "'", Conn
    If RecConfigCust.EOF Then
        IsConfigCustomer = 0
        RecConfigCust.Close
        Set RecConfigCust = Nothing
        Conn.Close
        Exit Function
    Else
        IsConfigCustomer = RecConfigCust("CustID")
        RecConfigCust.Close
        Set RecConfigCust = Nothing
        Conn.Close
        Exit Function
    End If
    Set RecConfigCust = Nothing
    Conn.Close
    Exit Function
E:
    MsgBox ("Error (" & Err.Description & ")... contact Michael")
End Function

' Check to see if this email has already been inserted
Public Function EmailInserted(strEntryID As String) As Boolean
'On Error GoTo E
    Dim Conn As ADODB.Connection
    Set Conn = New ADODB.Connection
    MM_MyConn_STRING = "Provider=SQLOLEDB.1;User Id=sa;Initial Catalog=Products;Data Source=glacier2"
    Conn.ConnectionString = MM_MyConn_STRING
    Conn.Open
    Dim RecEmail As ADODB.Recordset
    Set RecEmail = New ADODB.Recordset
    RecEmail.Open "Select OutlookEntryID From Comments Where OutlookEntryID='" & strEntryID & "'", Conn
    If RecEmail.EOF Then
        EmailInserted = False
        Set RecEmail = Nothing
        Conn.Close
        Set Conn = Nothing
        Exit Function
    Else
        EmailInserted = True
        Set RecEmail = Nothing
        Conn.Close
        Set Conn = Nothing
        Exit Function
    End If
E:
    MsgBox ("Error (" & Err.Description & ")... contact Michael")
End Function

' Insert the email that was just sent
Private Sub InsertSentEmail(ByVal Item As MailItem, CustID As Integer)
'On Error GoTo E
    Dim Conn As ADODB.Connection
    Set Conn = New ADODB.Connection
    MM_MyConn_STRING = "Provider=SQLOLEDB.1;User Id=sa;Initial Catalog=Products;Data Source=glacier2"
    Conn.ConnectionString = MM_MyConn_STRING
    If InStr(Item.Body, "--") <> 0 Then
        strBody = Left(Item.Body, InStr(Item.Body, "--") - 3)
    Else
        strBody = Item.Body
    End If
    If InStr(strBody, "<HR") <> 0 Then
        strBody = Left(strBody, InStr(Item.Body, "<HR") - 1)
    End If
    If InStr(strBody, "__") <> 0 Then
        strBody = Left(strBody, InStr(Item.Body, "__") - 1)
    End If
    Conn.Open
    Dim EmailNum As Integer
    Dim RecEmailNum As ADODB.Recordset
    Set RecEmailNum = New ADODB.Recordset
    RecEmailNum.Open "Select Top 1 CommentID From Comments Order By CommentID desc", Conn
    If RecEmailNum.EOF Then
        EmailNum = 1
    Else
        EmailNum = RecEmailNum("CommentID") + 1
    End If
    strBody = Replace(Replace(strBody, "'", ""), vbCr, "<BR>")
    strTo = Replace(Item.Recipients(1).Address, "'", "")
    strSubject = Replace(Item.Subject, "'", "")
    Dim StaffID As Integer
    ' The StaffID for MCallahan@sportsmanager.us
    StaffID = 2
    Conn.Execute "Insert Into Comments Values(" & EmailNum & ",'" & strBody & "','To'," & _
                 CustID & ",'" & strTo & "',-1,-1," & StaffID & ",'" & strSubject & "','" & _
                 Date & "','" & Date & " " & Time & "','','*Sent*" & Item.EntryID & "')"
    Conn.Execute "Update Login Set LastEmailedToDate='" & Date & "' Where CustID=" & CustID
    RecEmailNum.Close
    Set RecEmailNum = Nothing
    Conn.Close
    Exit Sub
E:
    MsgBox ("Error (" & Err.Description & ")... contact Michael")
End Sub


' Insert the email that was just recieved
Private Sub InsertRecievedEmail(ByVal Item As MailItem, CustID As Integer)
'On Error GoTo E
    Dim Conn As ADODB.Connection
    Set Conn = New ADODB.Connection
    MM_MyConn_STRING = "Provider=SQLOLEDB.1;User Id=sa;Initial Catalog=Products;Data Source=glacier2"
    Conn.ConnectionString = MM_MyConn_STRING
    If InStr(Item.Body, "--") <> 0 Then
        strBody = Left(Item.Body, InStr(Item.Body, "--") - 3)
    Else
        strBody = Item.Body
    End If
    If InStr(strBody, "<HR") <> 0 Then
        strBody = Left(strBody, InStr(Item.Body, "<HR") - 1)
    End If
    If InStr(strBody, "__") <> 0 Then
        strBody = Left(strBody, InStr(Item.Body, "__") - 1)
    End If
    Conn.Open
    Dim EmailNum As Integer
    Dim RecEmailNum As ADODB.Recordset
    Set RecEmailNum = New ADODB.Recordset
    RecEmailNum.Open "Select Top 1 CommentID From Comments Order By CommentID desc", Conn
    If RecEmailNum.EOF Then
        EmailNum = 1
    Else
        EmailNum = RecEmailNum("CommentID") + 1
    End If
    strBody = Replace(Replace(strBody, "'", ""), vbCr, "<BR>")
    strFrom = Replace(Item.Reply.Recipients(1).Address, "'", "")
    strSubject = Replace(Item.Subject, "'", "")
    ' The StaffID for MCallahan@sportsmanager.us
    StaffID = 2
    Conn.Execute "Insert Into Comments Values(" & EmailNum & ",'" & strBody & "','From'," & _
                 CustID & ",'" & strFrom & "',-1,-1," & StaffID & ",'" & strSubject & "','" & _
                 Month(Item.CreationTime) & "/" & Day(Item.CreationTime) & "/" & Year(Item.CreationTime) & "','" & Item.CreationTime & "','','" & Item.EntryID & "')"
    Conn.Execute "Update Login Set LastEmailedFromDate='" & Month(Item.CreationTime) & "/" & Day(Item.CreationTime) & "/" & Year(Item.CreationTime) & "' Where Cast(LastEmailedFromDate as datetime)<'" & Month(Item.CreationTime) & "/" & Day(Item.CreationTime) & "/" & Year(Item.CreationTime) & "' And CustID=" & CustID
    RecEmailNum.Close
    Set RecEmailNum = Nothing
    Conn.Close
    Exit Sub
E:
    MsgBox ("Error (" & Err.Description & ")... contact Michael")
End Sub

Sub EbaySearchEmail(objEmail As Object)
    Dim Conn As ADODB.Connection
    Set Conn = New ADODB.Connection
    MM_MyConn_STRING = "Provider=SQLOLEDB.1;User Id=sa;Initial Catalog=Products;Data Source=glacier2"
    Conn.ConnectionString = MM_MyConn_STRING
    Conn.Open
    Dim RecEbaySearch As ADODB.Recordset
    Set RecEbaySearch = New ADODB.Recordset
    Dim RecEbayListing As ADODB.Recordset
    Set RecEbayListing = New ADODB.Recordset
    Dim RecEbayListingExists As ADODB.Recordset
    Set RecEbayListingExists = New ADODB.Recordset
    RecEbaySearch.Open "Select EbaySearchID From EbaySearches Where ProductSearch='" & Trim(Replace(LCase(objEmail.Subject), "ebay favorite search: ", "")) & "'", Conn
    esnum = RecEbaySearch("EbaySearchID")
    Dim strEmail As String
    Dim Done As Boolean
    Dim strItemName, strItemLink, strItemNumber, strItemPrice, strBids, strBuyNow, strDate, strTime As String
    Done = False
    strEmail = objEmail.Body
  '  For i = 1 To 35
   '     strEmail = Replace(strEmail, "  ", " ")
   ' Next
    strEmail = Mid(strEmail, InStr(LCase(strEmail), "end date") + 8)
    If InStr(strEmail, ">") = 1 Then
         strEmail = Mid(strEmail, InStr(strEmail, ">") + 1)
    End If
    strEmail = Replace(Replace(Replace(strEmail, vbCr, ""), Chr(10), ""), vbTab, " ")
    strEmail = Replace(Replace(Replace(strEmail, "< /font>", ""), "< /a>", ""), "< /td>", "")
    Do Until Done = True
        If InStr(LCase(strEmail), "item=") = 0 Then
            Done = True
        Else
            strItemName = ""
            strItemNumber = ""
            strItemLink = ""
            strItemPrice = ""
            strBids = ""
            strBuyNow = ""
            strDate = ""
            strTime = ""
            strItemName = Trim(Left(strEmail, InStr(LCase(strEmail), "<") - 1))
            strEmail = Trim(Mid(strEmail, InStr(LCase(strEmail), "<") + 1))
            strTempEmail = Mid(strEmail, InStr(LCase(strEmail), "item=") + 5)
            strItemNumber = Replace(Left(strTempEmail, InStr(strTempEmail, "&") - 1), " ", "")
            strTempEmail = ""
            strItemLink = Replace(Left(strEmail, InStr(strEmail, ">") - 1), " ", "")
            If InStr(LCase(strItemLink), "item=" & strItemNumber) = 0 Then
                strEmail = Trim(Mid(strEmail, InStr(LCase(strEmail), ">") + 1))
                strItemName = Trim(Left(strEmail, InStr(strEmail, "<") - 1))
                strEmail = Trim(Mid(strEmail, InStr(LCase(strEmail), "<") + 1))
                strItemLink = Replace(Left(strEmail, InStr(strEmail, ">") - 1), " ", "")
            End If
            strEmail = Trim(Mid(strEmail, InStr(strEmail, "$") + 1))
            strItemPrice = Left(strEmail, InStr(strEmail, ".") + 2)
            If Left(strEmail, 1) = " " Then
                strEmail = Trim(Mid(strEmail, InStr(strEmail, " ") + 1))
            Else
                strEmail = Trim(Mid(strEmail, Len(strItemPrice) + 1))
            End If
            If Left(strEmail, 1) = "$" Then
                strEmail = Trim(Mid(strEmail, InStr(strEmail, " ") + 1))
            End If
            strBids = Left(strEmail, InStr(LCase(strEmail), " ") - 1)
            If InStr(strBids, "$") <> 0 Or InStr(strBids, ".") <> 0 Then
                strEmail = Trim(Mid(strEmail, InStr(strEmail, "$") + 1))
                strItemPrice = Left(strEmail, InStr(strEmail, ".") + 2)
                strEmail = Trim(Mid(strEmail, InStr(strEmail, " ") + 1))
                strBids = Left(strEmail, InStr(LCase(strEmail), " ") - 1)
            End If
            strEmail = Trim(Mid(strEmail, InStr(strEmail, " ") + 1))
            If Left(strEmail, 1) = "<" Then
                strEmail = Trim(Mid(strEmail, InStr(strEmail, ">") + 1))
            End If
            strTempEmail = Trim(Left(strEmail, InStr(LCase(strEmail), "pst") + 3))
            If InStr(LCase(strTempEmail), "buyitnow") = 0 Then
                strBuyNow = ""
            Else
                strBuyNow = "T"
                strEmail = Mid(strEmail, InStr(strEmail, ">") + 1)
            End If
            strTempEmail = ""
            strTempDate = Trim(Left(strEmail, InStr(LCase(strEmail), "pdt") - 1))
            strEmail = Trim(Mid(strEmail, InStr(LCase(strEmail), "pst") + 3))
            strTempDate = DateAdd("h", 3, strTempDate)
            If Hour(strTempDate) > 12 Then
                strDate = Month(strTempDate) & "/" & Day(strTempDate) & "/" & Year(strTempDate) & _
                          " " & Hour(strTempDate) - 12 & ":" & Minute(strTempDate) & ":" & _
                          Second(strTempDate) & " PM"
            Else
                 If Hour(strTempDate) < 12 Then
                    strDate = Month(strTempDate) & "/" & Day(strTempDate) & "/" & Year(strTempDate) & _
                              " " & Hour(strTempDate) & ":" & Minute(strTempDate) & ":" & _
                              Second(strTempDate) & " AM"
                 Else
                    strDate = Month(strTempDate) & "/" & Day(strTempDate) & "/" & Year(strTempDate) & _
                              " " & Hour(strTempDate) & ":" & Minute(strTempDate) & ":" & _
                              Second(strTempDate) & " PM"
                 End If
            End If
            strTempDate = ""
            strTime = Mid(strDate, InStr(strDate, " ") + 1)
            RecEbayListingExists.Open "Select EbayListingID From EbayListing Where ItemNumber='" & Replace(strItemNumber, "'", "") & "'", Conn
            If RecEbayListingExists.EOF Then
                RecEbayListing.Open "Select Top 1 EbayListingID From EbayListing Order By EbayListingID desc", Conn
                If RecEbayListing.EOF Then
                    elnum = 1
                Else
                    elnum = RecEbayListing("EbayListingID") + 1
                End If
                RecEbayListing.Close
                Conn.Execute "Insert Into EbayListing Values(" & elnum & "," & esnum & ",'" & Replace(strItemName, "'", "") & _
                             "','" & Replace(strItemLink, "'", "") & "','" & Replace(strItemNumber, "'", "") & _
                             "'," & Replace(Replace(strItemPrice, "'", ""), ",", "") & ",'" & Replace(strBids, "'", "") & _
                             "','" & Replace(strBuyNow, "'", "") & "','" & Replace(strDate, "'", "") & _
                             "','" & Replace(strTime, "'", "") & "','T','" & objEmail.CreationTime & "','','','','','','','')"
                cs = CheckSeller(strItemLink, Replace(strItemNumber, "'", ""))
                If cs = "" Then
                    cs = CheckSeller(strItemLink, Replace(strItemNumber, "'", ""))
                End If
                If cs = "" Then
                    cs = CheckSeller(strItemLink, Replace(strItemNumber, "'", ""))
                End If
                If cs = "" Then
                    cs = CheckSeller(strItemLink, Replace(strItemNumber, "'", ""))
                End If
            Else
                Conn.Execute "Update EbayListing Set EbaySearchID=" & esnum & ",ItemName='" & Replace(strItemName, "'", "") & _
                             "',ItemLink='" & Replace(strItemLink, "'", "") & _
                             "',ItemPrice=" & Replace(Replace(strItemPrice, "'", ""), ",", "") & ",ItemBids='" & Replace(strBids, "'", "") & _
                             "',ItemBuyNow='" & Replace(strBuyNow, "'", "") & "',ItemEndDate='" & Replace(strDate, "'", "") & _
                             "',ItemEndTime='" & Replace(strTime, "'", "") & "',Active='T',DateUpdated='" & objEmail.CreationTime & _
                             "' Where ItemNumber='" & Replace(strItemNumber, "'", "") & "'"
            End If
            RecEbayListingExists.Close
        End If
    Loop
    Conn.Execute "Update EbayListing Set Active='F' Where EbaySearchID=" & esnum & " And DateUpdated<'" & Date & "'"
    Conn.Execute "Update EbayListing Set Active='F' Where DateDiff(d,ItemEndDate,'" & Date & "') > 0"
    Conn.Close
End Sub
Private Function CheckSeller(strLink, strItem)
On Error Resume Next
    Dim Conn As ADODB.Connection
    Set Conn = New ADODB.Connection
    MM_MyConn_STRING = "Provider=SQLOLEDB.1;User Id=sa;Initial Catalog=Products;Data Source=glacier2"
    Conn.ConnectionString = MM_MyConn_STRING
    Conn.Open
    Dim IE As SHDocVw.InternetExplorer
    Set IE = CreateObject("InternetExplorer.Application")
    Dim strPage As String
    Dim strSeller As String
    IE.AddressBar = False
    IE.Visible = False
    IE.Navigate (strLink)
    Do While IE.Busy
    Loop
    strPage = Left(IE.Document.Body.innerText, 5000)
    Do While strPage = ""
        strPage = Left(IE.Document.Body.innerText, 5000)
    Loop
    IE.Quit
    Set IE = Nothing
    strPage = Replace(Replace(Replace(strPage, vbCr, ""), Chr(10), ""), vbTab, " ")
    strPage = Mid(strPage, InStr(LCase(strPage), "seller information") + 18)
    If InStr(strPage, "(") > 1 Then strSeller = Left(strPage, InStr(strPage, "(") - 1)
    If Len(strSeller) > 50 Then strPage = "***Unknown***"
    Conn.Execute "Update EbayListing Set SellerName='" & Replace(strSeller, "'", "") & "' Where ItemNumber='" & strItem & "'"
    Conn.Close
    CheckSeller = strSeller
End Function
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'On Error GoTo E
    Dim CustID As Integer
    CustID = IsConfigCustomer(Item.Recipients(1).Address)
    If CustID > 0 Then
        InsertSentEmail Item, CustID
    End If
    Exit Sub
E:
    MsgBox ("Error (" & Err.Description & ")... contact Michael")
End Sub

Private Sub Application_NewMail()
On Error GoTo E
    Dim onMAPI As NameSpace
    Dim ofFolder As MAPIFolder
    Dim objNewMail As MailItem
    Set onMAPI = GetNamespace("MAPI")
    Set ofFolder = onMAPI.GetDefaultFolder(olFolderInbox)
    If DateDiff("s", ofFolder.Items.GetLast.CreationTime, ofFolder.Items.GetFirst.CreationTime) > 0 Then
        Set objNewMail = ofFolder.Items.GetFirst
    Else
        Set objNewMail = ofFolder.Items.GetLast
    End If
    '"/o=new technology solutions, inc./ou=ntsi/cn=recipients/cn=mcallahan" Then '"mcallahan@sportsmanager.us" Then '
    If LCase(objNewMail.Reply.Recipients(1).Address) = "savedsearches@ebay.com" Then
        EbaySearchEmail objNewMail
        Exit Sub
    End If
    Dim strAddress As String
    If EmailInserted(objNewMail.EntryID) = False Then
        strAddress = objNewMail.Reply.Recipients(1).Address
        ' Make Sure the email is not coming directly from our server
        ' and that if copied to more than oner person here the email
        ' is saved only once
        If LCase(objNewMail.Recipients(1).Address) <> "mcallahan@sportsmanager.us" Then
            GoTo N
        End If
        ' Make sure this email is not coming from the configurator
        ' in which case it has already been saved
        If objNewMail.Subject = "NTSI Web Comment/Question" Or objNewMail.Subject = "NTSI Web Quote Comment/Question" Or objNewMail.Subject = "NTSI Web Quote Purchase" Or objNewMail.Subject = "NTSI Corporate/Volume Discount Request" Then
            GoTo N
        End If
        Dim CustID As Integer
        CustID = IsConfigCustomer(strAddress)
        If CustID > 0 Then
            InsertRecievedEmail objNewMail, CustID
        End If
    End If
N:
    Set objNewMail = Nothing
    Set objNewMail = ofFolder.Items.GetLast
    If EmailInserted(objNewMail.EntryID) = False Then
        strAddress = objNewMail.Reply.Recipients(1).Address
        ' Make Sure the email is not coming directly from our server
        ' and that if copied to more than oner person here the email
        ' is saved only once
        If LCase(objNewMail.Recipients(1).Address) <> "mcallahan@sportsmanager.us" Then
            Exit Sub
        End If
        ' Make sure this email is not coming from the configurator
        ' in which case it has already been saved
        If objNewMail.Subject = "NTSI Web Comment/Question" Or objNewMail.Subject = "NTSI Web Quote Comment/Question" Or objNewMail.Subject = "NTSI Web Quote Purchase" Or objNewMail.Subject = "NTSI Corporate/Volume Discount Request" Then
            Exit Sub
        End If
        CustID = IsConfigCustomer(strAddress)
        If CustID > 0 Then
            InsertRecievedEmail objNewMail, CustID
        End If
    End If
    Set objNewMail = Nothing
    Set ofFolder = Nothing
    Set onMAPI = Nothing
    Exit Sub
E:
    Debug.Print "Error (" & Err.Description & ")... contact Michael" & " " & Time & vbCr
End Sub

Private Sub Application_Startup()
'On Error Resume Next
    Dim intUnRead As Integer
    intUnRead = 0
    Dim strAddress As String
    Dim CustID As Integer
    Dim ofFolder As MAPIFolder
    Set ofFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    For Each mail In ofFolder.Items
        If mail.UnRead = True Then
            If EmailInserted(mail.EntryID) = False Then
                strAddress = mail.Reply.Recipients(1).Address
                ' Make Sure the email is not coming directly from our server
                ' and that if copied to more than oner person here the email
                ' is saved only once
                If LCase(mail.Recipients(1).Address) <> "mcallahan@sportsmanager.us" Then
                    Exit Sub
                End If
                ' Make sure this email is not coming from the configurator
                ' in which case it has already been saved
                If mail.Subject = "NTSI Web Comment/Question" Or mail.Subject = "NTSI Web Quote Comment/Question" Or mail.Subject = "NTSI Web Quote Purchase" Or mail.Subject = "NTSI Corporate/Volume Discount Request" Then
                    Exit Sub
                End If
                CustID = IsConfigCustomer(strAddress)
                If CustID > 0 Then
                    InsertRecievedEmail mail, CustID
                End If
            End If
        Else
            intUnRead = intUnRead + 1
            If intUnRead > 3 Then
                Exit For
            Else
                If EmailInserted(mail.EntryID) = False Then
                     strAddress = mail.Reply.Recipients(1).Address
                    ' Make Sure the email is not coming directly from our server
                    ' and that if copied to more than oner person here the email
                    ' is saved only once
                    If LCase(mail.Recipients(1).Address) <> "mcallahan@sportsmanager.us" Then
                        Exit Sub
                    End If
                    ' Make sure this email is not coming from the configurator
                    ' in which case it has already been saved
                    If mail.Subject = "NTSI Web Comment/Question" Or mail.Subject = "NTSI Web Quote Comment/Question" Or mail.Subject = "NTSI Web Quote Purchase" Or mail.Subject = "NTSI Corporate/Volume Discount Request" Then
                        Exit Sub
                    End If
                    CustID = IsConfigCustomer(strAddress)
                    If CustID > 0 Then
                        InsertRecievedEmail mail, CustID
                    End If
                End If
            End If
        End If
    Next
    Exit Sub
E:
  '  MsgBox ("Error (" & Err.Description & ")... contact Michael")
End Sub