Hi,
I have some VBA code that is on a users PC which copies the email to a folder - this code works fine without any problems. I have set the macro up on as a customized button.
However, the button keeps on disapearing every now and then and I have to keep on putting it back Using the Tools - Customize - Macro.
Any idea why this might be happening?
Thanks
VBA Code
Public Sub FileEmail()
Dim Exp As Explorer
Dim Sel As Selection
Dim Mail As MailItem
Dim NS As NameSpace
Dim fFiling As MAPIFolder
Dim idx As Long
On Error GoTo Handle
Set Exp = Application.ActiveExplorer
Set Sel = Exp.Selection
Set NS = Application.GetNamespace("MAPI")
Set fFiling = NS.Folders("Mailbox - AC").Folders("My Mail").Folders("Test Folder")
For idx = 1 To Sel.Count
Set Mail = Sel.Item(idx)
Mail.FlagStatus = olFlagMarked
Mail.FlagIcon = olRedFlagIcon
Mail.Copy
Mail.FlagStatus = olNoFlag
Mail.Move fFiling
Next idx
Finish:
Exit Sub
Handle:
Select Case Left(Err.Description, 10)
Case "The Explor":
MsgBox "No emails selected"
Case "Type misma":
MsgBox "At least one selected item is not an email"
Case Else:
MsgBox "Error : " & Err.Number & " " & Err.Description
End Select
Resume Finish
End Sub
I have some VBA code that is on a users PC which copies the email to a folder - this code works fine without any problems. I have set the macro up on as a customized button.
However, the button keeps on disapearing every now and then and I have to keep on putting it back Using the Tools - Customize - Macro.
Any idea why this might be happening?
Thanks
VBA Code
Public Sub FileEmail()
Dim Exp As Explorer
Dim Sel As Selection
Dim Mail As MailItem
Dim NS As NameSpace
Dim fFiling As MAPIFolder
Dim idx As Long
On Error GoTo Handle
Set Exp = Application.ActiveExplorer
Set Sel = Exp.Selection
Set NS = Application.GetNamespace("MAPI")
Set fFiling = NS.Folders("Mailbox - AC").Folders("My Mail").Folders("Test Folder")
For idx = 1 To Sel.Count
Set Mail = Sel.Item(idx)
Mail.FlagStatus = olFlagMarked
Mail.FlagIcon = olRedFlagIcon
Mail.Copy
Mail.FlagStatus = olNoFlag
Mail.Move fFiling
Next idx
Finish:
Exit Sub
Handle:
Select Case Left(Err.Description, 10)
Case "The Explor":
MsgBox "No emails selected"
Case "Type misma":
MsgBox "At least one selected item is not an email"
Case Else:
MsgBox "Error : " & Err.Number & " " & Err.Description
End Select
Resume Finish
End Sub