X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
   Reply to this topicStart new topic
> Outlook Automation - Error Connecting To Folder, Access 2016    
post Nov 14 2019, 09:56 AM

Posts: 364
Joined: 22-April 11

I'm trying to open an Inbox subfolder "GROUP EMAILS 2017 -" and on the second line below am getting error "...an object could not be found."
Dim objOutlook As Outlook.Application
Dim objInbox As Outlook.Folder
Dim objMailFolder As Outlook.Folder
Set objInbox = objOutlook.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox) 'Connect to default inbox
Set objMailFolder = objInbox.Folders("GROUP EMAILS 2017 -") 'Connect to sub folder

Is there something wrong with ths syntax?
Go to the top of the page
post Nov 14 2019, 09:58 AM

UA Moderator
Posts: 76,889
Joined: 19-June 07
From: SunnySandyEggo

Hi. The only thing I could think of is to double check the spelling.

Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page
post Nov 14 2019, 06:06 PM

Posts: 364
Joined: 22-April 11

Just to make sure I have the folder name correct, I added some code to iterate through all of the subfolders under Index and return the name of each subfolder. The folder count is 47, but fewer than 10 folder names are returned. As I step through this process, names are returned for Outlook's native folders (Sent, Drafts, Trash, etc.), but only one user folder name is returned, after which the loop terminates (without error). I find this a little odd and wonder if the PST file is corrupted, which is hardly unheard of.
Go to the top of the page
post Nov 15 2019, 12:34 PM

UA Moderator
Posts: 76,889
Joined: 19-June 07
From: SunnySandyEggo

Yeah, that sounds weird. Good luck!

Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page
post Nov 26 2019, 08:26 PM

Posts: 224
Joined: 20-March 06
From: Darwin, Australia

I understand you want to run through the list using outlook. Are all your .PST files opened within the outlook application or are they simply files in a directory?
If they are simply files than this is very difficult. If they are open in outlook then you can run through them.
I have been tinkering with excel to do an email search etc and have attached the zipped file. You can look through the procedures to see how to access outlook folders etc.
As always please check the file.

The file was written in older versions of excel but I have started to update them for 64 bit office. You might find it useful. Don't forget to review the references that it uses (i.e. active x for treeview).

I hope this is of use as much of th VBA can be used in Access VBA.

This post has been edited by tonez90: Nov 26 2019, 08:26 PM
Attached File(s)
Attached File  Email_searcher_V2.03.03__2_.zip ( 605.29K )Number of downloads: 1
Go to the top of the page
post Nov 26 2019, 08:52 PM

UtterAccess VIP
Posts: 3,677
Joined: 19-August 03
From: Auckland, Little Australia

I get files emailed to me, and I have a rule setup so they go to a certain folder (I actually have 2 rules, and 1 goes to a 'working' folder that gets the emails deleted from, other is a backup folder)

Anyway, I have this code that goes to that folder, and checks each message and checks for attachments matching a type (by extension e.g CSV, TXT, XLS etc)

Function SaveEmailAttachments(ByVal strOutlookFolderInInbox As String, ByVal strExt As String, ByVal strDestFolder As String) As Boolean
'Date:          Monday, 25 March 2019 9:56:06 AM
'Author:        Stephen Cooper
'Email:         coopers@XXXXXXXXX.com
'In parameters
'Example:       ?SaveEmailAttachments("PayGlobalCSV",".zip","C:\DataConversion\CSVXML\DownloadCSV")

On Error GoTo HandleError:

SaveEmailAttachments = True

Dim intMouseType As Integer
Dim strErrorMsg As String
Dim varReturn As Variant
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim Item As Object
Dim Atmt
Dim strFileName As String
Dim i As Integer
Dim objFSO As Object
Dim j As Integer
Dim intCount As Integer

intMouseType = Screen.MousePointer

DoCmd.Hourglass True

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders(strOutlookFolderInInbox)

i = 0
' Check subfolder for messages and exit if none found

intCount = SubFolder.Items.Count

If intCount = 0 Then
    GoTo ExitHere
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")

If Not objFSO.FolderExists(strDestFolder) Then
    MsgBox "Unable to find " & strDestFolder, vbInformation + vbOKOnly, "Missing Folder"
    GoTo ExitHere
End If

strDestFolder = CheckPath(strDestFolder)

' Check each message for attachments and extensions
For j = 1 To intCount
    'Should use just each item, but was giving inconsistent results
    For Each Item In SubFolder.Items
        For Each Atmt In Item.Attachments
            If LCase(Right(Atmt.FileName, Len(strExt))) = LCase(strExt) Then
                strFileName = strDestFolder & Atmt.FileName
                'Check if the file already exists, if so, delete it
                If objFSO.FileExists(strFileName) Then
                    objFSO.DeleteFile strFileName
                End If 'objFSO.FileExists(strFileName)
                Atmt.SaveAsFile strFileName
                'Audit it
                AuditAttachment strDestFolder, Atmt.FileName, Atmt.Size
                i = i + 1
            End If
        Next Atmt
        'Want to delete the message. Note ALL emails in the folder will be deleted
    Next Item
Next j

On Error Resume Next
'Close all recordsets etc here
varReturn = SysCmd(acSysCmdClearStatus)
Screen.MousePointer = intMouseType
Set SubFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
Set objFSO = Nothing
Exit Function

Select Case Err.Number
Case Else
    LogError "SaveEmailAttachments|" & CurrentProject.Name & "|" & strErrorMsg & "|" & Err.Number & " - " & Err.Description & "| Line number " & Erl
    MsgBox strErrorMsg & " " & Err.Number & " " & Err.Description, vbInformation, "Error"
    SaveEmailAttachments = False
    'DoCmd.Close acForm, strUpdateForm, acSaveNo
    Resume ExitHere
End Select

End Function

Beer, natures brain defragging tool.
Go to the top of the page

Custom Search

RSSSearch   Top   Lo-Fi    13th December 2019 - 01:16 AM