Outlook Automation search MAPIfolders

[RMcCallan]

I have some outlook automation code which is working fine there is just one thing which I can't get to work. Part of my code separates emails depending on the domain name of the sender email address, each has it's own folder. When there is a sender with a new domain name a new folder will be created. The problem is that I can't work out how to search the folders to check if the folder has already been created, does anybody know how I would go about this? Any replies appreciated!

Thanks,
Rebecca

 

[Remou]

You can use the FileSystemObject, either through a reference to Windows Script Host or with late binding:

Dim fs As Object

Set fs = CreateObject("Scripting.FilesystemObject")
If fs.FolderExists("C:\Docs") Then
   ''Do stuff
Else
    ''Create folder
End If

http://lessthandot.com

 

[PHV]

Remou, the OP ask about MAPIfolders, so the FSO is irrelevant.

Rebecca, why not posting your actual code.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Remou]

Oops. I was recently writing emails out to disk on a similar basis. For MAPI:

Public Function GetFolder(strFolderPath As String) As MAPIFolder
' strFolderPath needs to be something like
'   "Public Folders\All Public Folders\Company\Sales" or
'   "Personal Folders\Inbox\My Folder"

Dim objNS As NameSpace
Dim colFolders As Folders
Dim objFolder As MAPIFolder
Dim arrFolders() As String
Dim i As Long
  
On Error GoTo TrapError
    
    strFolderPath = Replace(strFolderPath, "/", "\")
    arrFolders() = Split(strFolderPath, "\")
    
    Set objNS = GetNamespace("MAPI")
    
    
    On Error Resume Next
    
    Set objFolder = objNS.Folders.Item(arrFolders(0))
    
    If Not objFolder Is Nothing Then
        For i = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(i))
            
            If objFolder Is Nothing Then
                Exit For
            End If
        Next
    End If

On Error GoTo TrapError
    
    Set GetFolder = objFolder
    Set colFolders = Nothing
    Set objNS = Nothing

Exit_Proc:
    Exit Function
    
TrapError:
    MsgBox Err.Number & " " & Err.Description

End Function

http://lessthandot.com

 

[RMcCallan]

Hmmm I'm not too sure that this would do what I want it to... I have quite a lot of code so will just post the bit where I want to search for the folder

Set rstClient = db.OpenRecordset("Select foldername from tbl001_clientdetails where hostname = '" & strClientHost & "'")
            If "'" & strFolderName & "'" <> rstClient!FolderName Then
            'Set new folder for client and move emails into it
                
                Set outOutlook = CreateObject("Outlook.Application")
                Set outNamespace = outOutlook.GetNamespace("MAPI")
                Set outItem = outNamespace.GetDefaultFolder(olFolderInbox)
                
                Set outFoldersClient = outFoldersClient.Folders("'" & strFolderName & "'")
                              
                outItem.Folders.Add ("'" & strFolderName & "'")
                
                Set outOutlook = Nothing
                Set outNamespace = Nothing
                Set outItem = Nothing                         
            Else
                MailObject.Move outFoldersClient
            End If

It is in the if statement that i want to search - as I explain I would like to set up a new folder if the sender does not have a folder so in the IF statement I want to check whether the folder is there or not - strFolderName holds the name whether the folder is present or not by using the sender's email and removing anything before the @ symbol and anything such as .co.uk or .com etc therefore the foldername will just be the domain name and so senders in the same domain will be held in the same folder(the <> rstClient!FolderName does not work because if its a new sender thir folder name is nto in the recordset yet) Hope this helps? Cheers for your replies and help.

Thanks,
Rebecca