Results 1 to 2 of 2
  1. #1
    5 Star Lounger
    Join Date
    Nov 2004
    Wilmington, North Carolina, USA
    Thanked 0 Times in 0 Posts

    Need example code import outlook email text (A2k)

    Here's some code I found *out there*, adapted somewhat to suit my needs:

    Private Sub get_Emails(strEmailContents As String)

    Dim strEmailBody As String
    'declare a variable to hold the email body text
    'if your field is not called contents, change this bit below
    strEmailBody = strEmailContents

    'stremail now holds the email body

    'these are variables to show the email where the body "headers" are
    rankpos = 0
    lastnamepos = 0
    usernamepos = 0

    'these are variables to show where in the email body the actual values are
    rank = ""
    lastname = ""
    UserName = ""

    'this is a variable to show where we are in the email body....
    currentpos = 1

    'look for the words "Rank:" - this must be EXACLTY how it appears in the email
    rankpos = InStr(currentpos, strEmailBody, "Rank:")
    currentpos = rankpos

    lastnamepos = InStr(currentpos, strEmailBody, "Last Name:")
    currentpos = lastnamepos

    usernamepos = InStr(currentpos, strEmailBody, "Username:")
    currentpos = usernamepos

    'we now know where all the headers are, so find the text inbetween them and assign them to the appropriate variables:
    'ie the first name wiil be between First Name and Last Name

    If rankpos <> 0 And lastnamepos <> 0 Then
    fieldlen = Len("Rank:")
    firstname = Mid(strEmailBody, rankpos + fieldlen, lastnamepos - (rankpos + fieldlen))
    End If

    If lastnamepos <> 0 And usernamepos <> 0 Then
    fieldlen = Len("Last Name:")
    lastname = Mid(strEmailBody, lastnamepos + fieldlen, usernamepos - (lastnamepos + fieldlen))
    End If

    Dim srtSQLInsert As String

    strSQLInsert = "insert into [company_user] ([rank],[last_name],[username]) values('" & Trim(rank) & "','" & Trim(lastname) & "','" & Trim(UserName) & "')"

    DoCmd.SetWarnings (False)

    DoCmd.RunSQL (strSQLInsert)

    End Sub

    However, I still don't know how to get the email into access....The following code is provided, but I'm having trouble understanding it.

    Private Sub Form_Open(Cancel As Integer)

    Dim dbs As Database
    Dim rst As DAO.Recordset

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("Outlook New Registration Emails")

    With rst
    If .RecordCount <> 0 Then
    Do While Not rst.EOF
    'procedure from button
    get_Emails (rst.Fields("Contents"))
    End If
    End With

    'deletes all the records in the linked outlook table
    deleteoutlookregistrationtable = "Delete from [Outlook New Registration Emails]"

    'this command runs the deletion of the outlook registrations new table
    DoCmd.SetWarnings (False)
    DoCmd.RunSQL (deleteoutlookregistrationtable)
    DoCmd.SetWarnings (False)

    DoCmd.Quit ACSaveAll

    End Sub
    "If you spend more on coffee than on IT security, then you will be hacked. What&#39;s more, you deserve to be hacked." -Richard Clarke

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Thanked 31 Times in 31 Posts

    Re: Need example code import outlook email text (A2k)

    The code assumes that you have imported e-mails from Outlook into a table named "Outlook New Registration Emails".

    You can do that by selecting File | Get External Data | Import..., and selecting Outlook from the Files of Type dropdown list in the Open dialog.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts