Results 1 to 2 of 2
  1. #1
    5 Star Lounger
    Join Date
    Nov 2004
    Location
    Wilmington, North Carolina, USA
    Posts
    1,196
    Thanks
    0
    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"))
    rst.MoveNext
    Loop
    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.Close
    DoCmd.Quit ACSaveAll

    End Sub
    ____________________________
    Jeremy
    "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
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 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
  •