' Outlook VB Macro to save attachments to folder

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim saveDate As String
saveFolder = "\\intranet\employer\UserData\Users\DTalle1\documents\_temp"
saveDate = Format(itm.ReceivedTime, "ddmmyy")
For Each objAtt In itm.Attachments
  objAtt.SaveAsFile saveFolder & "\" & Mid(objAtt.DisplayName, 1, Len(objAtt.DisplayName) - 4) & " " & _
	saveDate & Mid(objAtt.DisplayName, Len(objAtt.DisplayName) - 3, 4)
  Set objAtt = Nothing
Next
End Sub

' Outlook VB Macro to move selected mail item(s) to a target folder

Public Sub MoveEmail()

'On Error Resume Next

Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim moveFromFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Dim i, j, k, l, m As Integer

Set ns = Application.GetNamespace("MAPI")

'For i = 1 To ns.Folders.Count
' Debug.Print "Level 1 - " & ns.Folders(i).Name
' For j = 1 To ns.Folders(i).Folders.Count
'  Debug.Print "Level 2 -- " & ns.Folders(i).Folders(j).Name
'  For k = 1 To ns.Folders(i).Folders(j).Folders.Count
'   Debug.Print "Level 3 --- " & ns.Folders(i).Folders(j).Folders(k).Name
'   For l = 1 To ns.Folders(i).Folders(j).Folders(k).Folders.Count
'    Debug.Print "Level 4 ---- " & ns.Folders(i).Folders(j).Folders(k).Folders(l).Name
'    For m = 1 To ns.Folders(i).Folders(j).Folders(k).Folders(l).Folders.Count
'     Debug.Print "Level 5 ----- " & ns.Folders(i).Folders(j).Folders(k).Folders(l).Folders(m).Name
'    Next m
'   Next l
'  Next k
' Next j
'Next i

'Define path to the target folder
Set moveToFolder = ns.Folders("Tallett, David").Folders("Inbox").Folders("Daily Mash API").Folders("Execute")
Set moveFromFolder = ns.Folders("Tallett, David").Folders("Inbox")
For i = 1 To moveFromFolder.Items.Count - 1
    Set objItem = moveFromFolder.Items(i)
    If objItem.Subject = "Daily Mash" Then
     objItem.Move moveToFolder
    End If
Next i

Set objItem = Nothing
Set moveFromFolder = Nothing
Set moveToFolder = Nothing
Set ns = Nothing
End Sub