[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 968
  • Last Modified:

Outlook VBA - Mail won't Move

Why would this not work? When a mail is sent, its EntryID is set to the caption of an object called mail on userform1, userform1 is displayed (the code below is userform1's), and a button is clicked to decide where to file the mail.
At the moment there's only one button for testing, MoveToFolder which moves the mail from sent items to inbox.
The OpenMAPIFolder function is needed because this is going to be used for moving mails between exchange mailboxes.

Basically, I get an error about 9 lines down, where I've marked 'HERE, saying an object is required. in debug, olMessage displays as the subject of the correct email. what gives?

Private Sub MoveToFolder_Click()
   Dim olSentItems
   Set olSentFolder = OpenMAPIFolder("\Personal Folders\Sent Items")
   Dim olMessage As Outlook.MailItem
   Set SentFolderItems = olSentFolder.Items
   
   For Each olMessage In SentFolderItems
    If olMessage.EntryID = mail.Caption Then
        MoveMessagesToFolder (olMessage)  ' HERE
        Exit For
    End If
    Next
End Sub


Sub MoveMessagesToFolder(Item As Outlook.MailItem)
   Dim olkFolder As Outlook.MAPIFolder
   Set olkFolder = OpenMAPIFolder("\Personal Folders\Inbox")
   Item.Move olkFolder
   Set olkFolder = Nothing
End Sub

Function OpenMAPIFolder(szPath)
   Dim app, ns, flr, szDir, i
   Set flr = Nothing
   Set app = CreateObject("Outlook.Application")
   If Left(szPath, Len("\")) = "\" Then
       szPath = Mid(szPath, Len("\") + 1)
   Else
       Set flr = app.ActiveExplorer.CurrentFolder
   End If
   While szPath <> ""
       i = InStr(szPath, "\")
       If i Then
           szDir = Left(szPath, i - 1)
           szPath = Mid(szPath, i + Len("\"))
       Else
           szDir = szPath
           szPath = ""
       End If
       If IsNothing(flr) Then
           Set ns = app.GetNamespace("MAPI")
           Set flr = ns.Folders(szDir)
       Else
           Set flr = flr.Folders(szDir)
       End If
   Wend
   Set OpenMAPIFolder = flr
End Function

Function IsNothing(Obj)
 If TypeName(Obj) = "Nothing" Then
   IsNothing = True
 Else
   IsNothing = False
 End If
End Function
0
KennyLowe
Asked:
KennyLowe
1 Solution
 
bruintjeCommented:
Hello KennyLowe,
--------

try it without the parentheses else vb expects a return value to be stored in a new variable like

dim x as object
x = MoveMessagesToFolder (olMessage)

so your new code would look like

Private Sub MoveToFolder_Click()
   Dim olSentItems
   Set olSentFolder = OpenMAPIFolder("\Personal Folders\Sent Items")
   Dim olMessage As Outlook.MailItem
   Set SentFolderItems = olSentFolder.Items
   
   For Each olMessage In SentFolderItems
    If olMessage.EntryID = mail.Caption Then
        MoveMessagesToFolder  olMessage
        Exit For
    End If
    Next
End Sub

--------
bruintje
sharing what you know, learning what you don't
0
 
KennyLoweAuthor Commented:
Cheers! Short and sweet, damn my C knowledge:)
0

Featured Post

Independent Software Vendors: 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!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now