Working from Word or Access, I am looking for code to prompt the user for the name of an outlook folder

I posted this question ( http:/Q_27314268.html ) and got a great response that works fine from outlook.

I would like the code to prompt the user for the name of the folder (possibly offer a list of folders for the user to choose from) if possible.

I would appreciate any help you can offer
Sub amendOutbox()
Dim olkApp As Object
Dim mai As Object
Dim acct As Long

    acct = getAccount
    If acct = 0 Then acct = 1
    Set olkApp = CreateObject("outlook.application")
    For Each mai In olkApp.Session.GetDefaultFolder(4).items
        If mai.Class = 43 Then
            With mai
                .Importance = 2
                .ReadReceiptRequested = True
                .OriginatorDeliveryReportRequested = True
                .Attachments.Add "e:\0\Access - (001) 042307.ADA Fee Proposal.pdf", 5
                .SendUsingAccount = olkApp.Session.Accounts.Item(acct)
                .SentOnBehalfOfName = olkApp.Session.Accounts.Item(acct)
' Need to establish the account required ... but once set can be hard coded.
                .Send
                MsgBox acct & vbNewLine & olkApp.Session.Accounts.Item(acct)
            End With
        End If
    
    Next

End Sub

Function getAccount() As Long
Dim olkApp As Object
Dim i As Long
    
' Accounts only valid for 2007 and on!
'can embed it as Access call if required via:
' acct = getaccount()
    
    Set olkApp = CreateObject("outlook.application")
    For i = 1 To olkApp.Session.Accounts.Count
        If (MsgBox("Use Account " & olkApp.Session.Accounts.Item(i).SmtpAddress, vbYesNo)) = vbYes Then 'olkApp.Session.accounts.item(i)
            getAccount = i
            Exit For
        End If
    Next

'    MsgBox "account selected as :> " & getAccount

End Function

Open in new window

rogerdjrAsked:
Who is Participating?
 
Chris BottomleyConnect With a Mentor Commented:
Allowing for operator cancel on the selection then ...

Chris
Sub amendOutbox()
Dim olkApp As Object
Dim mai As Object
Dim acct As Long
Dim fldr As Object

    acct = getAccount
    If acct = 0 Then acct = 1
    Set olkApp = CreateObject("outlook.application")
    Set fldr = olkApp.Session.PickFolder
    If fldr Is Nothing Then Exit Sub
    For Each mai In fldr.Items
        If mai.Class = 43 Then
            With mai
                .Importance = 2
                .ReadReceiptRequested = True
                .OriginatorDeliveryReportRequested = True
                .Attachments.Add "e:\0\Access - (001) 042307.ADA Fee Proposal.pdf", 5
                .SendUsingAccount = olkApp.Session.Accounts.Item(acct)
                .SentOnBehalfOfName = olkApp.Session.Accounts.Item(acct)
' Need to establish the account required ... but once set can be hard coded.
                .Send
                MsgBox acct & vbNewLine & olkApp.Session.Accounts.Item(acct)
            End With
        End If
    
    Next

End Sub

Open in new window

0
 
Chris BottomleyCommented:
Try:

    Set fldr = olkapp.Session.PickFolder

Chris
0
 
rogerdjrAuthor Commented:
Folder picker provides the prompt to pick a folder, works great

But I'm not sure how to incorporate into the code above to have it edit the emails in the folder selected from the picker

Thanks
0
 
Chris BottomleyCommented:
For Each mai In olkApp.Session.pickfolder.items
0
 
rogerdjrAuthor Commented:
Works Perfect Thanks
0
All Courses

From novice to tech pro — start learning today.