Solved

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

Posted on 2004-09-29
11
286 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 5
11 Comments
 
LVL 2

Accepted Solution

by:
jfrent earned 50 total points
ID: 12186324
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
ID: 12194002
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
ID: 12213841
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
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 

Author Comment

by:donaldwat
ID: 12214097
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
ID: 12214212
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
 

Author Comment

by:donaldwat
ID: 12214230
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
ID: 12214321
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
ID: 12214334
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
ID: 12214400
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
ID: 12232740
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
ID: 12232876

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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
AutoNumbers should increment automatically, without duplicates.  But sometimes something goes wrong, and the next AutoNumber value is a duplicate.  This article shows how to recover from this problem.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

710 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