I have developed a short macro that allows my 365 users to save email out to the project folders. I have 2 users that are still on 2010, and I can not figure out why the code wont work. I thought it was a reference or something just as easy, but no luck. Here is the code if anyone has an idea
Sub SaveACopy() 'ByVal Item As Object) 'Item As Object
Const olMsg As Long = 3
Dim m As MailItem
Dim strPath As String
Set m = GetCurrentItem
If TypeName(m) <> "MailItem" Then Exit Sub
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Dim fd As Office.FileDialog
Set fd = xlApp.Application.FileDialog(msoFileDialogFolderPicker)
Dim selectedItem As Variant
If fd.Show = -1 Then
For Each selectedItem In fd.SelectedItems
Debug.Print selectedItem
strPath = selectedItem
Next
End If
Set fd = Nothing
xlApp.Quit
Set xlApp = Nothing
Dim strSubject As String
strSubject = m.Subject
strSubject = Replace(strSubject, ":", "")
'strPath = """" & strPath
strPath = strPath & "\" & strSubject
strPath = strPath & " " & Format(Now(), "ddmmmyyyy-hhNNss") '"yyyy-mm-dd-hhnnss" YYYY-mm-dd
strPath = strPath & ".msg"
strPath = strPath '& """"
m.SaveAs strPath, olMsg
m.Close olDiscard
End Sub
'Set objItem = objApp.ActiveExplorer.Selection.Item(1)
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function