Solved

Need help with exisiting code. reading attachments and save to MS Access

Posted on 2004-09-29
11
281 Views
Last Modified: 2012-08-13
I have a bit of code whereas I have basically given up. I know that I am close by examining the output but this is what is happening. I want to be able to read an outlook email and then the attachments. I want to be able to export the name, subject, DateSent, Filename and message to an MS Access table. I have it "somewhat" working but what is happening is that the subject is duplicating. The situation is that an email can have several attachments but naturally one subject. What I get is the:

txtName      txtSubject      txtDateSent      txtFileName      txtMessage
donald      donaldduck      9/29/2004 9:09:09 AM      C:\Donald\0305.xls      "Test
 "
donald      donaldduck      9/29/2004 9:09:09 AM      C:\Donald\0302 (2).xls      "Test
 "
donald      donaldduck      9/29/2004 9:09:09 AM      C:\Donald\0302 (2)_OK.xls      "Test
 "
 
What I should get is
txtName      txtSubject      txtDateSent      txtFileName      txtMessage
donald      donaldduck      9/29/2004 9:09:09 AM      C:\Donald\0305.xls      "Test
 "
donald      donaldduck      9/29/2004 9:09:09 AM      C:\Donald\0302 (2).xls      "Test
 "
donald      Duck      9/29/2004 9:09:09 AM      C:\Donald\0302 (2)_OK.xls      "Test
 "


The code I have using is:

Public Sub StoreOutlookItems()
Dim OlApp As Outlook.Application
Dim OlMapi As Outlook.NameSpace
Dim OlFolder 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 rst As Recordset

Dim Item As Object
Dim Atmt As Attachment
Dim Filename As String
Dim i As Integer

Set rst = CurrentDb.OpenRecordset("tblMyTable") ' - Create a connection to outlook
Set OlApp = CreateObject("Outlook.Application") ' or Set OlApp = New Outlook.Application
Set OlMapi = OlApp.GetNamespace("MAPI") ' - Open the inbox
Set OlFolder = OlMapi.Folders("Personal Folders").Folders("Inbox")
Set OlItems = OlFolder.Items    ' - For each mail in the collection check the subject line and process accordingly

For Each OlMail In OlItems
If OlFolder.Items.Count > 0 Then
For Each Item In OlFolder.Items
    For Each Atmt In Item.Attachments
            rst.AddNew
        rst!txtName = OlMail.SenderName
        rst!txtsubject = OlMail.subject
        rst!txtdatesent = OlMail.ReceivedTime
        rst!txtMessage = OlMail.Body
        rst!txtFilename = "C:\Donald\" & Atmt.Filename '& OlFolder.Subject
        rst.Update
        i = i + 1
    Next Atmt
    Next Item
End If
Screen.MousePointer = 0
Next

End Sub


Where am I going wrong?


0
Comment
Question by:donaldwat
  • 6
  • 5
11 Comments
 
LVL 2

Accepted Solution

by:
jfrent earned 50 total points
Comment Utility
I believe you might have one extra level of looping in there or you are loading your recordset with the wrong object.  I indented my copy of your code as follows...

<snip>

For Each OlMail In OlItems
    If OlFolder.Items.Count > 0 Then
        For Each Item In OlFolder.Items
            For Each Atmt In Item.Attachments
                rst.AddNew
                rst!txtName = OlMail.SenderName
                rst!txtsubject = OlMail.subject
                rst!txtdatesent = OlMail.ReceivedTime
                rst!txtMessage = OlMail.Body
                rst!txtFilename = "C:\Donald\" & Atmt.Filename '& OlFolder.Subject
                rst.Update
                i = i + 1
            Next Atmt
        Next Item
    End If
    Screen.MousePointer = 0
Next

< end snip>

I noticed that your recordset is being loaded using the OLMail object
(i.e. rst!txtName = OlMail.SenderName)

I think this should be the Item Object
(i.e. rst!txtName = Item.SenderName)

And again perhaps there is an extra level of looping here.

The two lines of code (sorry for taking them out of context):
Set OlItems = OlFolder.Items
For Each Item In OlFolder.Items
Refer to the same collection correct?


I think if you use the following code to replace the code listed above, you will get the results you are after.


<snip>

    If OlFolder.Items.Count > 0 Then
        For Each Item In OlFolder.Items
            For Each Atmt In Item.Attachments
                rst.AddNew
                rst!txtName = Item.SenderName
                rst!txtsubject = Item.subject
                rst!txtdatesent = Item.ReceivedTime
                rst!txtMessage = Item.Body
                rst!txtFilename = "C:\Donald\" & Atmt.Filename '& Item.Subject
                rst.Update
                i = i + 1
            Next Atmt
        Next Item
    End If
    Screen.MousePointer = 0

< end snip>

Hope that helps
0
 

Author Comment

by:donaldwat
Comment Utility
Pefect. Works like a charm now. Addition to the same question. Is there any way to FREEZE/Loop the Subject whereas the "x" number of attachments (file names) are added to the field? The look would be:

txtName     txtSubject     txtDateSent                                  txtFileName                         txtMessage
donald     donaldduck     9/29/2004 9:09:09 AM     C:\File1.xls, File2.pdf, File3.xls                 "Test
donald     abc                9/29/2004 9:09:09 AM            NO ATTACHMENTS                          "Test
donald     xyz                9/29/2004 9:09:09 AM      C:\File1.xls, File2.doc                             "Test

This would be the finished product.
0
 
LVL 2

Expert Comment

by:jfrent
Comment Utility
Add this line at the top of the procedure:

Dim strAttach as string

The remaining code is replacement for code listed above:

If OlFolder.Items.Count > 0 Then
    For Each Item In OlFolder.Items
        strAttach = ""
        If Item.Attachments.Count = 0 Then
            strAttach = "NO ATTACHMENTS"
        Else
            For Each Atmt In Item.Attachments
                If strAttach <> "" Then
                    strAttach = strAttach & "," 'Add comma, if needed
                End If
                strAttach = strAttach & Atmt.Filename
            Next Atmt
        End If
       
        rst.AddNew
        rst!txtName = Item.SenderName
        rst!txtsubject = Item.subject
        rst!txtdatesent = Item.ReceivedTime
        rst!txtMessage = Item.Body
        rst!txtFilename = strAttach
        rst.Update
        i = i + 1
    Next Item
End If
Screen.MousePointer = 0
0
 

Author Comment

by:donaldwat
Comment Utility
This works perfectly when I want to save the results to my 'root" drive but i want to "point" to a folder. When I add the following, I am only able to save/display ONE (1) of the attachment. Any idea what is wrong with the following: Keeping in mind that each hyperkink with pertain to a separate file. menaing when I click on one of the several files in the field, I want THAT file.


If OlFolder.Items.Count > 0 Then
    For Each Item In OlFolder.Items
        strAttach = ""
        If Item.Attachments.Count = 0 Then
            strAttach = "NO ATTACHMENTS"
        Else
            For Each Atmt In Item.Attachments
                If strAttach <> "" Then
                    strAttach = strAttach & "," 'Add comma, if needed
                End If
                ' strAttach = path & Atmt.Filename & "#" & strAttach
                strAttach = strAttach & "#E:\CSC_Group\ETAV\Attachments_Pending\" & Atmt.Filename & "#"
            Next Atmt
        End If
0
 
LVL 2

Expert Comment

by:jfrent
Comment Utility
I'm not sure what you are trying to do or where you are when your "clicking" on a link.  I want to help you, but your are very far away from the original question.  You might want to consider posting another question.

As far as I know you wanted to save the name of the file in your table.  If you are clicking on links and such outside of outlook/outlook express you are going to have to break up the string that is created and handle each file/link seperately.  If you want to post more detail about what you are trying to do, I'll see if I can help.  But again, you may consider submitting another question to get other's involved.
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 

Author Comment

by:donaldwat
Comment Utility
Sorry. I spoke too soon. I get all three file names listed in the message box. But only see and are appending the 1st file from the message box into the table.Sorry I wasn't clear originally. Any thoughts - or should I re-post? It's doing what I want but only to the 1st attachment.

0
 
LVL 2

Expert Comment

by:jfrent
Comment Utility
You talk about "message box", is this when you are testing or are you talking about a list control?  I'm a little confused about what you are doing -- sorry if I'm slow, but I don't get it.

Also, what is the purpose of putting the "#" before and after each filename?  I thought the # identified a date...

Sorry man, your losing me.
0
 

Author Comment

by:donaldwat
Comment Utility
The "#" signs are required, at least I discovered it works to symbolize an hyperlinked field in MS Access. The message box was for testing to see if the file names were actually being read in. They are - but only one (of the three) files are created as a hyperlink in the table.
Sorry that I am losing you...
0
 
LVL 2

Expert Comment

by:jfrent
Comment Utility
I'm not sure if this is the problem or not, but mine kept erroring out on the recordset lines

        rst!txtName = Item.SenderName
        rst!txtsubject = Item.subject
        rst!txtdatesent = Item.ReceivedTime
        rst!txtMessage = Item.Body
        rst!txtFilename = strAttach

So I changed it to...

        rst(txtName) = Item.SenderName
        rst(txtsubject) = Item.subject
        rst(txtdatesent) = Item.ReceivedTime
        rst(txtMessage) = Item.Body
        rst(txtFilename) = strAttach

Where the txtName, txtSubject, txtDateSent variables were defined earlier in the code as the field names in the table.

After making that change, I ran and all of my attachments were listed in each record with the comma delimiter...

Any help?
0
 

Author Comment

by:donaldwat
Comment Utility
Sorry it took so long to respond.
Made changes as suggested. New ERROR on this line.

strText = strText & "#E:\CSC_Group\ETAV\Attachments_Pending\" & Item.Attachments.Item(i).Filename & "#;"

error is: "Array index is out-of-bounds."

Suggestion? So close....

0
 
LVL 2

Expert Comment

by:jfrent
Comment Utility

I think you want to stick with the Atmt object:

strAttach = strAttach & "#E:\CSC_Group\ETAV\Attachments_Pending\" & Atmt.Filename & "#"

Each time it passes this line it will (should) add the Filename for that attachment.  To For..Next loop specifies Each Atmt in Item.Attachments.

If you've changed your code significantly (I also noticed your changed strAttach to strText). You may want to repost your code.
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now