' Dennis DeOcampo
' dennis@ourITSource.com
' Date: 12/22/2019
' Latest Update: 01/08/2020
' Summary: This program counts the number of email that arrives on each mailbox by sending email information to an online mySQL database.
Option Explicit
Private Monitor1 As Outlook.MAPIFolder
Private Monitor2 As Outlook.MAPIFolder
Private Monitor3 As Outlook.MAPIFolder
Private Monitor4 As Outlook.MAPIFolder
Private Monitor5 As Outlook.MAPIFolder
Private Monitor6 As Outlook.MAPIFolder
Private Monitor7 As Outlook.MAPIFolder
Private Monitor8 As Outlook.MAPIFolder
Private Monitor9 As Outlook.MAPIFolder
Private Monitor10 As Outlook.MAPIFolder
Private Monitor11 As Outlook.MAPIFolder
Private Monitor12 As Outlook.MAPIFolder
Private Monitor13 As Outlook.MAPIFolder
Private Monitor14 As Outlook.MAPIFolder
Private Monitor15 As Outlook.MAPIFolder
Private Monitor16 As Outlook.MAPIFolder
Private Monitor17 As Outlook.MAPIFolder
Private Monitor18 As Outlook.MAPIFolder
Private Monitor19 As Outlook.MAPIFolder
Private Monitor20 As Outlook.MAPIFolder
Private Monitor21 As Outlook.MAPIFolder
Private Monitor22 As Outlook.MAPIFolder
Private Monitor23 As Outlook.MAPIFolder
Private Monitor24 As Outlook.MAPIFolder
Private Monitor25 As Outlook.MAPIFolder
Private Monitor26 As Outlook.MAPIFolder
Private Monitor27 As Outlook.MAPIFolder
Private Monitor28 As Outlook.MAPIFolder
Private Monitor29 As Outlook.MAPIFolder
Private Monitor30 As Outlook.MAPIFolder
Private Monitor31 As Outlook.MAPIFolder
Private Monitor32 As Outlook.MAPIFolder
Private Monitor33 As Outlook.MAPIFolder
Private Monitor34 As Outlook.MAPIFolder
Private Monitor35 As Outlook.MAPIFolder
Private Monitor36 As Outlook.MAPIFolder
Private Monitor37 As Outlook.MAPIFolder
Private Monitor38 As Outlook.MAPIFolder
Private Monitor39 As Outlook.MAPIFolder
Private Monitor40 As Outlook.MAPIFolder
Private Monitor41 As Outlook.MAPIFolder
Private Monitor42 As Outlook.MAPIFolder
Private Monitor43 As Outlook.MAPIFolder
Private Monitor44 As Outlook.MAPIFolder
Private Monitor45 As Outlook.MAPIFolder
'Private Monitor46 As Outlook.MAPIFolder
Private Monitor47 As Outlook.MAPIFolder
Private Monitor48 As Outlook.MAPIFolder
Private Monitor49 As Outlook.MAPIFolder
Private Monitor50 As Outlook.MAPIFolder
Private Monitor51 As Outlook.MAPIFolder
Private WithEvents Received1 As Outlook.Items
Private WithEvents Received2 As Outlook.Items
Private WithEvents Received3 As Outlook.Items
Private WithEvents Received4 As Outlook.Items
Private WithEvents Received5 As Outlook.Items
Private WithEvents Received6 As Outlook.Items
Private WithEvents Received7 As Outlook.Items
Private WithEvents Received8 As Outlook.Items
Private WithEvents Received9 As Outlook.Items
Private WithEvents Received10 As Outlook.Items
Private WithEvents Received11 As Outlook.Items
Private WithEvents Received12 As Outlook.Items
Private WithEvents Received13 As Outlook.Items
Private WithEvents Received14 As Outlook.Items
Private WithEvents Received15 As Outlook.Items
Private WithEvents Received16 As Outlook.Items
Private WithEvents Received17 As Outlook.Items
Private WithEvents Received18 As Outlook.Items
Private WithEvents Received19 As Outlook.Items
Private WithEvents Received20 As Outlook.Items
Private WithEvents Received21 As Outlook.Items
Private WithEvents Received22 As Outlook.Items
Private WithEvents Received23 As Outlook.Items
Private WithEvents Received24 As Outlook.Items
Private WithEvents Received25 As Outlook.Items
Private WithEvents Received26 As Outlook.Items
Private WithEvents Received27 As Outlook.Items
Private WithEvents Received28 As Outlook.Items
Private WithEvents Received29 As Outlook.Items
Private WithEvents Received30 As Outlook.Items
Private WithEvents Received31 As Outlook.Items
Private WithEvents Received32 As Outlook.Items
Private WithEvents Received33 As Outlook.Items
Private WithEvents Received34 As Outlook.Items
Private WithEvents Received35 As Outlook.Items
Private WithEvents Received36 As Outlook.Items
Private WithEvents Received37 As Outlook.Items
Private WithEvents Received38 As Outlook.Items
Private WithEvents Received39 As Outlook.Items
Private WithEvents Received40 As Outlook.Items
Private WithEvents Received41 As Outlook.Items
Private WithEvents Received42 As Outlook.Items
Private WithEvents Received43 As Outlook.Items
Private WithEvents Received44 As Outlook.Items
Private WithEvents Received45 As Outlook.Items
'Private WithEvents Received46 As Outlook.Items
Private WithEvents Received47 As Outlook.Items
Private WithEvents Received48 As Outlook.Items
Private WithEvents Received49 As Outlook.Items
Private WithEvents Received50 As Outlook.Items
Private WithEvents Received51 As Outlook.Items
Private Sub Application_Startup()
Set Monitor1 = Application.GetNamespace("MAPI").Folders("dvdeocampo@outlook.com").Folders("Inbox")
Set Monitor2 = Application.GetNamespace("MAPI").Folders("BillbacksFSSE@acosta.com").Folders("Inbox")
Set Monitor3 = Application.GetNamespace("MAPI").Folders("FSSampleBillBacks@acosta.com").Folders("Inbox")
Set Monitor4 = Application.GetNamespace("MAPI").Folders("BillBacks_Midwest_FS@acosta.com").Folders("Inbox")
Set Monitor5 = Application.GetNamespace("MAPI").Folders("BillbacksFSWest@acosta.com").Folders("Inbox")
Set Monitor6 = Application.GetNamespace("MAPI").Folders("BillbacksFSCentral@acosta.com").Folders("Inbox")
Set Monitor7 = Application.GetNamespace("MAPI").Folders("FSCommWest@acosta.com").Folders("Inbox")
Set Monitor8 = Application.GetNamespace("MAPI").Folders("FSCommEast@acosta.com").Folders("Inbox")
Set Monitor9 = Application.GetNamespace("MAPI").Folders("AcostaFSFaxWest@acosta.com").Folders("Inbox")
Set Monitor10 = Application.GetNamespace("MAPI").Folders("AcostaFSFaxCentral@acosta.com").Folders("Inbox")
Set Monitor11 = Application.GetNamespace("MAPI").Folders("AcostaFSFax@acosta.com").Folders("Inbox")
Set Monitor12 = Application.GetNamespace("MAPI").Folders("AcostaFSFaxMW@acosta.com").Folders("Inbox")
Set Monitor13 = Application.GetNamespace("MAPI").Folders("AcostaFSFaxNE@acosta.com").Folders("Inbox")
Set Monitor14 = Application.GetNamespace("MAPI").Folders("AcostaFSFaxSE@acosta.com").Folders("Inbox")
Set Monitor15 = Application.GetNamespace("MAPI").Folders("DeductionsFS@acosta.com").Folders("Inbox")
Set Monitor16 = Application.GetNamespace("MAPI").Folders("PricingFS@acosta.com").Folders("Inbox")
Set Monitor17 = Application.GetNamespace("MAPI").Folders("ordersSE@acosta.com").Folders("Inbox")
Set Monitor18 = Application.GetNamespace("MAPI").Folders("ordersNE@acosta.com").Folders("Inbox")
Set Monitor19 = Application.GetNamespace("MAPI").Folders("ordersFSWest@acosta.com").Folders("Inbox")
Set Monitor20 = Application.GetNamespace("MAPI").Folders("ordersFSMW@acosta.com").Folders("Inbox")
Set Monitor21 = Application.GetNamespace("MAPI").Folders("ordersFSCentral@acosta.com").Folders("Inbox")
Set Monitor22 = Application.GetNamespace("MAPI").Folders("samplesFL@acosta.com").Folders("Inbox")
Set Monitor23 = Application.GetNamespace("MAPI").Folders("samplesMW@acosta.com").Folders("Inbox")
Set Monitor24 = Application.GetNamespace("MAPI").Folders("samplesWest@acosta.com").Folders("Inbox")
Set Monitor25 = Application.GetNamespace("MAPI").Folders("samplesNE@acosta.com").Folders("Inbox")
Set Monitor26 = Application.GetNamespace("MAPI").Folders("samplesSE@acosta.com").Folders("Inbox")
Set Monitor27 = Application.GetNamespace("MAPI").Folders("SamplesCentral@acosta.com").Folders("Inbox")
Set Monitor28 = Application.GetNamespace("MAPI").Folders("Clientbillingcentral@acosta.com").Folders("Inbox")
Set Monitor29 = Application.GetNamespace("MAPI").Folders("ClientbillingMW@acosta.com").Folders("Inbox")
Set Monitor30 = Application.GetNamespace("MAPI").Folders("ClientbillingNE@acosta.com").Folders("Inbox")
Set Monitor31 = Application.GetNamespace("MAPI").Folders("ClientbillingSE@acosta.com").Folders("Inbox")
Set Monitor32 = Application.GetNamespace("MAPI").Folders("ClientbillingWest@acosta.com").Folders("Inbox")
Set Monitor33 = Application.GetNamespace("MAPI").Folders("ProgramsFSSE@acosta.com").Folders("Inbox")
Set Monitor34 = Application.GetNamespace("MAPI").Folders("ProgramsFSNE@acosta.com").Folders("Inbox")
Set Monitor35 = Application.GetNamespace("MAPI").Folders("ProgramsFSMidwest@acosta.com").Folders("Inbox")
Set Monitor36 = Application.GetNamespace("MAPI").Folders("ProgramsFSCentral@acosta.com").Folders("Inbox")
Set Monitor37 = Application.GetNamespace("MAPI").Folders("ProgramsFSWest@acosta.com").Folders("Inbox")
Set Monitor38 = Application.GetNamespace("MAPI").Folders("BidsSE@acosta.com").Folders("Inbox")
Set Monitor39 = Application.GetNamespace("MAPI").Folders("CornerStoneSamples@acosta.com").Folders("Inbox")
Set Monitor40 = Application.GetNamespace("MAPI").Folders("FoodServiceCommunications@acosta.com").Folders("Inbox")
Set Monitor41 = Application.GetNamespace("MAPI").Folders("CornerStoneOPS@acosta.com").Folders("Inbox")
Set Monitor42 = Application.GetNamespace("MAPI").Folders("CornerStoneSales@acosta.com").Folders("Inbox")
Set Monitor43 = Application.GetNamespace("MAPI").Folders("CornerStoneBids@acosta.com").Folders("Inbox")
Set Monitor44 = Application.GetNamespace("MAPI").Folders("CornerStoneLC@acosta.com").Folders("Inbox")
Set Monitor45 = Application.GetNamespace("MAPI").Folders("CornerStoneSamples@acosta.com").Folders("Inbox")
'Set Monitor46 = Application.GetNamespace("MAPI").Folders("CornerStoneCS@acosta.com").Folders("Inbox")
Set Monitor47 = Application.GetNamespace("MAPI").Folders("DocLibrary@acosta.com").Folders("Inbox")
Set Monitor48 = Application.GetNamespace("MAPI").Folders("FSMDM@acosta.com").Folders("Inbox")
Set Monitor49 = Application.GetNamespace("MAPI").Folders("acostacstonefax@acosta.com").Folders("Inbox")
Set Monitor50 = Application.GetNamespace("MAPI").Folders("QualityFS@acosta.com").Folders("Inbox")
Set Monitor51 = Application.GetNamespace("MAPI").Folders("BillbacksFSNE@acosta.com").Folders("Inbox")
Set Received1 = Monitor1.Items
Set Received2 = Monitor2.Items
Set Received3 = Monitor3.Items
Set Received4 = Monitor4.Items
Set Received5 = Monitor5.Items
Set Received6 = Monitor6.Items
Set Received7 = Monitor7.Items
Set Received8 = Monitor8.Items
Set Received9 = Monitor9.Items
Set Received10 = Monitor10.Items
Set Received11 = Monitor11.Items
Set Received12 = Monitor12.Items
Set Received13 = Monitor13.Items
Set Received14 = Monitor14.Items
Set Received15 = Monitor15.Items
Set Received16 = Monitor16.Items
Set Received17 = Monitor17.Items
Set Received18 = Monitor18.Items
Set Received19 = Monitor19.Items
Set Received20 = Monitor20.Items
Set Received21 = Monitor21.Items
Set Received22 = Monitor22.Items
Set Received23 = Monitor23.Items
Set Received24 = Monitor24.Items
Set Received25 = Monitor25.Items
Set Received26 = Monitor26.Items
Set Received27 = Monitor27.Items
Set Received28 = Monitor28.Items
Set Received29 = Monitor29.Items
Set Received30 = Monitor30.Items
Set Received31 = Monitor31.Items
Set Received32 = Monitor32.Items
Set Received33 = Monitor33.Items
Set Received34 = Monitor34.Items
Set Received35 = Monitor35.Items
Set Received36 = Monitor36.Items
Set Received37 = Monitor37.Items
Set Received38 = Monitor38.Items
Set Received39 = Monitor39.Items
Set Received40 = Monitor40.Items
Set Received41 = Monitor41.Items
Set Received42 = Monitor42.Items
Set Received43 = Monitor43.Items
Set Received44 = Monitor44.Items
Set Received45 = Monitor45.Items
'Set Received46 = Monitor46.Items
Set Received47 = Monitor47.Items
Set Received48 = Monitor48.Items
Set Received49 = Monitor49.Items
Set Received50 = Monitor50.Items
Set Received51 = Monitor51.Items
End Sub
'----------------------------------
Private Sub Received1_ItemAdd(ByVal Item As Object)
' Dim Sender As String
' Sender = Item.SenderEmailAddress
' Dim Subject As String
' Subject = Item.Subject
' Subject = Replace(Subject, "\'", "")
' Subject = Replace(Subject, "'", "")
'MsgBox "New mail from " & Item.SenderName & " in " & Monitor1.Parent.Name
'Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "dvdeocampo@outlook.com")
End Sub
'----------------------------------
Private Sub Received2_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "BillBacksFSSE@acosta.com")
End Sub
Private Sub Received3_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "FSSampleBillBacks@acosta.com")
End Sub
Private Sub Received4_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "BillBacks_Midwest_FS@acosta.com")
End Sub
Private Sub Received5_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "BillBacksFSWest@acosta.com")
End Sub
Private Sub Received6_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "BillBacksFSCentral@acosta.com")
End Sub
Private Sub Received7_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "FSCommWest@acosta.com")
End Sub
Private Sub Received8_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "FSCommEast@acosta.com")
End Sub
Private Sub Received9_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "AcostaFSFaxWest@acosta.com")
End Sub
Private Sub Received10_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "AcostaFSFaxCentral@acosta.com")
End Sub
Private Sub Received11_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "AcostaFSFax@acosta.com")
End Sub
Private Sub Received12_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "AcostaFSFaxMW@acosta.com")
End Sub
Private Sub Received13_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "AcostaFSFaxNE@acosta.com")
End Sub
Private Sub Received14_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "AcostaFSFaxSE@acosta.com")
End Sub
Private Sub Received15_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "DeductionsFS@acosta.com")
End Sub
'----------------------------------
Private Sub Received16_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "PricingFS@acosta.com")
End Sub
Private Sub Received17_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "OrdersSE@acosta.com")
End Sub
Private Sub Received18_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "OrdersNE@acosta.com")
End Sub
Private Sub Received19_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "OrdersFSWest@acosta.com")
End Sub
Private Sub Received20_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "OrdersFSMW@acosta.com")
End Sub
Private Sub Received21_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "OrdersFSCentral@acosta.com")
End Sub
Private Sub Received22_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "samplesFL@acosta.com")
End Sub
Private Sub Received23_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "samplesMW@acosta.com")
End Sub
Private Sub Received24_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "samplesWest@acosta.com")
End Sub
Private Sub Received25_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "samplesNE@acosta.com")
End Sub
Private Sub Received26_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "samplesSE@acosta.com")
End Sub
Private Sub Received27_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "samplesCentral@acosta.com")
End Sub
Private Sub Received28_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ClientBillingCentral@acosta.com")
End Sub
Private Sub Received29_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ClientBillingMW@acosta.com")
End Sub
Private Sub Received30_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ClientBillingNE@acosta.com")
End Sub
Private Sub Received31_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ClientBillingSE@acosta.com")
End Sub
Private Sub Received32_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ClientBillingWest@acosta.com")
End Sub
Private Sub Received33_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ProgramsFSSE@acosta.com")
End Sub
Private Sub Received34_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ProgramsFSNE@acosta.com")
End Sub
Private Sub Received35_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ProgramsFSMidWest@acosta.com")
End Sub
Private Sub Received36_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ProgramsFSCentral@acosta.com")
End Sub
Private Sub Received37_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "ProgramsFSWest@acosta.com")
End Sub
Private Sub Received38_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "BidsSE@acosta.com")
End Sub
Private Sub Received39_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "CornerStoneSamples@acosta.com")
End Sub
Private Sub Received40_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "FoodServiceCommunications@acosta.com")
End Sub
Private Sub Received41_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "CornerStoneOPS@acosta.com")
End Sub
Private Sub Received42_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "CornerStoneSales@acosta.com")
End Sub
Private Sub Received43_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "CornerStoneBids@acosta.com")
End Sub
Private Sub Received44_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "CornerStoneLC@acosta.com")
End Sub
Private Sub Received45_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "CornerStoneSamples@acosta.com")
End Sub
Private Sub Received46_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "CornerStoneCS@acosta.com")
End Sub
Private Sub Received47_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "DocLibrary@acosta.com")
End Sub
Private Sub Received48_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "FSMDM@acosta.com")
End Sub
Private Sub Received49_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "acostacstonefax@acosta.com")
End Sub
Private Sub Received50_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "QualityFS@acosta.com")
End Sub
Private Sub Received51_ItemAdd(ByVal Item As Object)
On Error Resume Next
Call ProcessItem2(Item.Subject, Item.SenderEmailAddress, "BillbacksFSNE@acosta.com")
End Sub
Private Sub Application_Quit()
'Perform Clean Up
Set Monitor1 = Nothing
Set Monitor2 = Nothing
Set Monitor3 = Nothing
Set Monitor4 = Nothing
Set Monitor5 = Nothing
Set Monitor6 = Nothing
Set Monitor7 = Nothing
Set Monitor8 = Nothing
Set Monitor9 = Nothing
Set Monitor10 = Nothing
Set Monitor11 = Nothing
Set Monitor12 = Nothing
Set Monitor13 = Nothing
Set Monitor14 = Nothing
Set Monitor15 = Nothing
Set Monitor16 = Nothing
Set Monitor17 = Nothing
Set Monitor18 = Nothing
Set Monitor19 = Nothing
Set Monitor20 = Nothing
Set Monitor21 = Nothing
Set Monitor22 = Nothing
Set Monitor23 = Nothing
Set Monitor24 = Nothing
Set Monitor25 = Nothing
Set Monitor26 = Nothing
Set Monitor27 = Nothing
Set Monitor28 = Nothing
Set Monitor29 = Nothing
Set Monitor30 = Nothing
Set Monitor31 = Nothing
Set Monitor32 = Nothing
Set Monitor33 = Nothing
Set Monitor34 = Nothing
Set Monitor35 = Nothing
Set Monitor36 = Nothing
Set Monitor37 = Nothing
Set Monitor38 = Nothing
Set Monitor39 = Nothing
Set Monitor40 = Nothing
Set Monitor41 = Nothing
Set Monitor42 = Nothing
Set Monitor43 = Nothing
Set Monitor44 = Nothing
Set Monitor45 = Nothing
'Set Monitor46 = Nothing
Set Monitor47 = Nothing
Set Monitor48 = Nothing
Set Monitor49 = Nothing
Set Monitor50 = Nothing
Set Monitor51 = Nothing
Set Received1 = Nothing
Set Received2 = Nothing
Set Received3 = Nothing
Set Received4 = Nothing
Set Received5 = Nothing
Set Received6 = Nothing
Set Received7 = Nothing
Set Received8 = Nothing
Set Received9 = Nothing
Set Received10 = Nothing
Set Received11 = Nothing
Set Received12 = Nothing
Set Received13 = Nothing
Set Received14 = Nothing
Set Received15 = Nothing
Set Received16 = Nothing
Set Received17 = Nothing
Set Received18 = Nothing
Set Received19 = Nothing
Set Received20 = Nothing
Set Received21 = Nothing
Set Received22 = Nothing
Set Received23 = Nothing
Set Received24 = Nothing
Set Received25 = Nothing
Set Received26 = Nothing
Set Received27 = Nothing
Set Received28 = Nothing
Set Received29 = Nothing
Set Received30 = Nothing
Set Received31 = Nothing
Set Received32 = Nothing
Set Received33 = Nothing
Set Received34 = Nothing
Set Received35 = Nothing
Set Received36 = Nothing
Set Received37 = Nothing
Set Received38 = Nothing
Set Received39 = Nothing
Set Received40 = Nothing
Set Received41 = Nothing
Set Received42 = Nothing
Set Received43 = Nothing
Set Received44 = Nothing
Set Received45 = Nothing
'Set Received46 = Nothing
Set Received47 = Nothing
Set Received48 = Nothing
Set Received49 = Nothing
Set Received50 = Nothing
Set Received51 = Nothing
End Sub
Private Sub ProcessItem2(eSubject As String, FromEmail As String, ToEmail As String)
On Error Resume Next
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sqlstr As String
Dim server_name As String
Dim database_name As String
Dim user_id As String
Dim Password As String
Dim mailbox As String
Dim dateTime As String
eSubject = Replace(eSubject, "\'", "")
eSubject = Replace(eSubject, "'", "")
'----------------------------------------------------------------------
' Establish connection to the database
server_name = "www.ouritsource.com"
database_name = "ourit_fito"
user_id = "ourit_fito"
Password = "afmit1954!!!"
Set conn = New ADODB.Connection
conn.Open "DRIVER={MySQL ODBC 8.0 ANSI Driver}" _
& ";SERVER=" & server_name _
& ";DATABASE=" & database_name _
& ";UID=" & user_id _
& ";PWD=" & Password _
& ";OPTION=16427" ' Option 16427 = Convert LongLong to Int: This just helps makes sure that large numeric results get properly interpreted
'---------------------------------------------
' Extract MySQL table data to first worksheet in the workbook
dateTime = Year(Date) & "-" & Month(Date) & "-" & Day(Date) & " " & Hour(Time) & ":" & Minute(Time) & ":" & Second(Time)
Set rs = New ADODB.Recordset
sqlstr = "insert into emailHistory (transdate,toField,fromField,subject) values ('" & dateTime & "','" + ToEmail + "','" + FromEmail + "','" + eSubject + "')"
rs.Open sqlstr, conn, adOpenStatic
'-----------------------------------------------------------------------
' Close connections
rs.Close
conn.Close
Set conn = Nothing
Set rs = Nothing
'Log
Const ForAppending = 8
Dim strLogFile, strDate, objFSO, objLogFile
strDate = Date
strLogFile = "c:\Logs\" & Year(strDate) & Month(strDate) & Day(strDate) & ".log"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.OpenTextFile(strLogFile, ForAppending, True)
objLogFile.WriteLine sqlstr & ";"
objLogFile.Close
End Sub
