ireka2007,
Ok, here is some food for thought.
In my situation I have a button on a form that the user clicks and the code
in the "OnClick" event of that button is run. The code calls a function in a
module. Now if that is confusing to you, do not worry. Take things one step
at a time, and you will learn quickly.
First, I have to assume that you already have your table or tables where the
data is going to be placed. So, create a form and place a command button on
that form and name the button "cmdGetEmailData" or any appropriate name you
choose and save your form. (This form could actually be an existing form.)
In design mode of your form, select you button and display the properties
dialog box. Click on the "Event" tab of the properties dialog box. Locate
the "On Click" event and place your cursor in that row and then click the
down arrow that is at the end of that row. Select the [Event Procedure]
option from that list. Now, click the button just to the right of the down
arrow. This will take you to the VBA code window with some statements
already in place. You should see something like this:
Option Compare Database
Option Explicit
Private Sub cmdGetEmailContacts_Click()
End Sub
Now, from the menu at the top of the VBA code window, from the Insert menu
option, select "Module". A new module will be created. Copy the code below
and paste it into this new module. (Just for the record, this code is not
mine. I acquired it from another web site. I think is was the "The Access
Web". Anyway, I just want to give credit to the author.) You will need to
work though this code and replace various references with actual references
to the things that you have. For example, in the following statement:
Set OlCatalogs = Olfolder.Folders("Catalogs")
you would need to change the "Catalogs" folder to the folder where your
emails are going to be. There are other places where you will need to make
adjustments, but hopefully this will get you started in the right direction.
'start of code for module
Option Compare Database
Option Explicit
Public Sub ImportOutlookItems()
Dim Olapp As Outlook.Application
Dim Olmapi As Outlook.NameSpace
Dim Olfolder As Outlook.MAPIFolder
Dim OlAccept As Outlook.MAPIFolder
Dim OlRead As Outlook.MAPIFolder
Dim OlDecline As Outlook.MAPIFolder
Dim OlFailed As Outlook.MAPIFolder
Dim OlCatalogs As Outlook.MAPIFolder
Dim OlMail As Object 'Have to late bind as appointments e.t.c screw it up
Dim OlItems As Outlook.Items
Dim OlRecips As Outlook.Recipients
Dim OlRecip As Outlook.Recipient
Dim Rst As DAO.Recordset
Dim rs As DAO.Recordset
Dim strLastName As String
Dim strFirstName As String
Dim strAddress1 As String
Dim strAddress2 As String
Dim strCity As String
Dim strState As String
Dim strZip As String
Dim strPhone As String
Dim strSort As String
Dim strEmail As String
Dim strCompany As String
Dim strSql As String
Dim strMsg As String
Dim strSubjectVal As String
Dim strDelimeter As String
Dim varRecCnt, varEmailsToImport
'Set Rst = CurrentDb.OpenRecordset("tbl_Temp") 'Open table tbl_temp
'Create a connection to outlook
Set Olapp = CreateObject("Outlook.Application")
Set Olmapi = Olapp.GetNamespace("MAPI")
'Open the inbox
'Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
'specify the inbox folder where the emails will exist
Set OlCatalogs = Olfolder.Folders("Catalogs")
'Set OlItems = Olfolder.Items
Set OlItems = OlCatalogs.Items
'Set up the folders the mails are going to be deposited in
'Set OlAccept = Olfolder.Folders("Accept")
'Set OlDecline = Olfolder.Folders("Decline")
'Set OlFailed = Olfolder.Folders("Failed")
'specify the folder where the mail is to be moved to after the data is read
Set OlRead = Olfolder.Folders("Catalogs Sent")
'Set up a loop to run till the inbox is empty (otherwise it skips some)
varEmailsToImport = OlItems.Count
'Do Until OlItems.Count = 0
'Reset the olitems object otherwise new incoming mails and moving mails get
missed
Set OlItems = OlCatalogs.Items
For Each OlMail In OlItems
'For each mail in the collection check the subject line and process
accordingly
' If OlMail.UnRead = True Then
' OlMail.UnRead = False 'Mark mail as read
' Rst.AddNew
' Rst!Name = OlMail.SenderName
' If InStr(1, OlMail.Subject, "Accept") > 0 Then
' Rst!Status = "Attending"
' Rst!datesent = OlMail.ReceivedTime
' OlMail.Move OlAccept
' ElseIf InStr(1, OlMail.Subject, "Decline") > 0 Then
' Rst!datesent = OlMail.ReceivedTime
' Rst!Status = "Decline"
' OlMail.Move OlDecline
' Else
' Rst!datesent = OlMail.ReceivedTime
' Rst!Status = "Failed"
' OlMail.Move OlFailed
' End If
' Rst.Update
' End If
strSubjectVal = OlMail.Subject
If InStr(1, OlMail.Subject, "Catalog Request") > 0 Then
Dim strContent As String
strDelimeter = "|"
strContent = OlMail.Body
'Dim lngEndOfFieldNames As Long
'lngEndOfFieldNames = InStr(1, strContent, "EX_CUSTOMER")
'strContent = Right(strContent, Len(strContent) -
(lngEndOfFieldNames + 11))
'Dim charCode
'Dim charLoc
Dim nxtCharLoc
Dim FieldStartLoc
'charLoc = 1
FieldStartLoc = 1
'read the "First Name" from the email
strFirstName = Mid(strContent, FieldStartLoc,
InStr(FieldStartLoc, strContent, strDelimeter) - 1)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'Read the "Last Name" from then email
strLastName = Mid(strContent, FieldStartLoc,
InStr(FieldStartLoc, strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'Read the "first Address ield
strAddress1 = Mid(strContent, FieldStartLoc,
InStr(FieldStartLoc, strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'Read the second Address field
strAddress2 = Mid(strContent, FieldStartLoc,
InStr(FieldStartLoc, strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'read the City field
strCity = Mid(strContent, FieldStartLoc, InStr(FieldStartLoc,
strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'read the State field
strState = Mid(strContent, FieldStartLoc, InStr(FieldStartLoc,
strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'read the Zip
strZip = Mid(strContent, FieldStartLoc, InStr(FieldStartLoc,
strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'read the Phone
strPhone = Mid(strContent, FieldStartLoc, InStr(FieldStartLoc,
strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'read the "Sort" field
strSort = Mid(strContent, FieldStartLoc, InStr(FieldStartLoc,
strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'read the Email field
strEmail = Mid(strContent, FieldStartLoc, InStr(FieldStartLoc,
strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
'read the Company field
strCompany = Mid(strContent, FieldStartLoc, InStr(FieldStartLoc,
strContent, strDelimeter) - FieldStartLoc)
FieldStartLoc = InStr(FieldStartLoc, strContent, strDelimeter) + 1
End If
OlMail.UnRead = False 'Mark mail as read
OlMail.Move OlRead
'check to see is a duplicate name already exists in the database
strSql = "SELECT Count(Contacts.ContactID) AS CountOfContactID FROM
Contacts " _
& "WHERE (((Contacts.sLastName)='" & strLastName & "') " _
& "AND ((Contacts.sFirstName)='" & strFirstName & "') " _
& "AND ((Left([sPostalCode],5))='" & strZip & "'));"
Set rs = CurrentDb.OpenRecordset(strSql)
varRecCnt = rs.Fields("CountOfContactID").Value
rs.Close
Set rs = Nothing
'if no other record was found, write the new record
If varRecCnt = 0 Then
Set rs = CurrentDb.OpenRecordset("Contacts")
rs.AddNew
rs.Fields("sFirstName").Value = UCase(strFirstName)
rs.Fields("sLastName").Value = UCase(strLastName)
rs.Fields("sAddress1").Value = UCase(strAddress1)
rs.Fields("sAddress2").Value = UCase(strAddress2)
rs.Fields("sCity").Value = UCase(strCity)
rs.Fields("sStateOrProvince").Value = UCase(strState)
rs.Fields("sPostalCode").Value = strZip
rs.Fields("sPhone").Value = strPhone
rs.Fields("sEmail").Value = strEmail
rs.Fields("sCompany").Value = strCompany
rs.Fields("bNeedsCatalog").Value = -1
rs.Fields("dtDateLastUpdated").Value = Date
rs.Fields("AddedBy").Value = 0 'zero is to be use to indicate
that the record came from email
rs.Fields("DateAdded").Value = Date
rs.Update
rs.Close
Set rs = Nothing
Else
'reduce the "varEmailsToImport" variable by 1
varEmailsToImport = varEmailsToImport - 1
End If
Next
'Loop
'MsgBox "Your wish is my command. New mails have been checked. Please
check the tbl_temp for details", vbOKOnly
'when all emails have been read
If varEmailsToImport = 0 Then
strMsg = "No Catalog Requests from email were imported. Duplicate
Request Found!"
ElseIf varEmailsToImport = 1 Then
strMsg = varEmailsToImport & " Catalog Request from an email was
imported!"
Else
strMsg = varEmailsToImport & " Catalog Requests from emails were
imported!"
End If
MsgBox strMsg, vbOKOnly, "Emails Read"
If IsLoaded("frmManageContacts") Then
Forms!frmManageContacts.lblEmailArrived.Visible = False
Forms!frmManageContacts.lstContacts.Requery
End If
End Sub
'end of code for module
Watch out for line wraping when you copy the code above. you may need to
remove some new line entries for the code to work.
When you are prompted to save the module you can provide you own name or
name it "modReadEmail". If you use your own name for the module, just be sure
that the name you give the module is not the same as one of the functions
that are in the module. There are lines in this code that are commented out
because in my specific situation, I was not using that functionality. Read
the comments that are in the code and you will get more information about
just what all can be done using this code. There is quite a bit.
Next, in the "On Click" event that you already have, place this statement to
call the "ImportOutlookItems" function in the new module. The entire code
for the On Click event will now look like the following:
Private Sub cmdGetEmailContacts_Click()
ImportOutlookItems
End Sub
Complie and Save your code, module and your form.
When you have modified the code in the module to fit your objects, the code
should allow you to read information from an email.
I realize that I have presented a lot to you. If you work through using
this, you will have learned a lot. If, on the other hand, you feel
overwhelmed by all of this, there may come a point where you may need some
additional help.
Please do not fail to post your specific questions. I know some on this
newsgroup will be glad to assist.
