How to fix Macros for Outlook 2013 (saving attachments)?

Question

Macros

Hey!
Anyone who is strong in VBA.
There is a macro for Outlook, which was found on the Internet, and the functionality of which is supposed to save attached files to the C:\ drive from emails in a certain folder in Outlook 2013.
The macro seems to have been written for earlier versions of Outlook, and the save file function does not work.
Please help with adapting it to Outlook 2013.
Here is the source (with comments):
Sub SaveAllAttachments(objitem As MailItem)
Dim objMessage As Object
Dim objHighlighted As Outlook.Items
Dim objAttachments As Outlook.Attachments
Dim strName, strLocation As String
Dim dblCount, dblLoop As Double
' If you are using this code you will need to edit this
' line so that it matches the location within outlook
' of the folder you intend to scan
' NOTE!! Only edit the "Personal Folders\Processing..."
'''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''
Set fld = GetFolder("Inbox\Omniture")
'''''''''''''''''''' ''''''''''''''''''''''
'NOTE! Only edit C:\Documents and Settings\Administrator\Desktop\macro\
'''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''
strLocation = "C:\Omniture"
''''' '''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''
''''''' On Error GoTo ExitSub
' Check each selected item for attachments.
' If attachments exist, save them to the Macro
' folder on the Desktop.
For Each objMessage In objHighlighted ' For each email in the folder
If objMessage.Class = olMail Then ' ONLY scan emails!!
Set objAttachments = objMessage.Attachments
' Now to set my loop to the amount of attachments For Each objMessage In objHighlighted ' For each email in the folder If objMessage.Class = olMail Then ' ONLY scan emails!! Set objAttachments = objMessage.Attachments ' Now to set my loop to the amount of attachments For Each objMessage In objHighlighted ' For each email in the folder If objMessage.Class = olMail Then ' ONLY scan emails!! Set objAttachments = objMessage.Attachments ' Now to set my loop to the amount of attachments
' on the current email the script is processing.
dblCount = objAttachments.Count
If dblCount <= 0 Then GoTo 100 ' If no attachments exsist
' go to the next email.
' I know this part looks weird...But If I counted
' upwards, the script was not recognizing every
' email and was skipping like half of them. By
'counting downwards, this problem is resolved.
' Thanks to Slovaktech.com for solving this one.
For dblLoop = dblCount To 1 Step -1
' This will be appended to the file name of each attachment to insure
' that there are no duplicates, and therefor nothing gets overwritten
strID = " from " & Format(Date, "mm-dd-yy") 'Append the Date
strID = strID & " at " & Format(Time, "hh`mm `ss AMPM") 'Append the Time
' These lines are going to retrieve the name of the
' attachment, attach the strID to it to insure it is
' a unique name, and then insure that the file
' extension is appended to the end of the file name.
strName = objAttachments.Item(dblLoop).FileName '
strName = Left$(strName, Len(strName) - 4) 'Remove file Extension
strName = strName & strID & strExt 'Reattach Extension
' Tell the script where to save it and
' what to call it
strName = strLocation & strName 'Put it all together
' Save the attachment as a file.
objAttachments.Item(dblLoop).SaveAsFile strName 'Save the attachment
' This next line DELETES the email completly.
' If you do not wish to delete the email
' change this line to read objMessage.Save
'''''''''''''''''''
objMessage.Save
''''''''''''''''''''
' This section of code is optional. It puts a 1 second
' delay between file saves so that my strID is unique
' for EVERY file. I do this because the script does
'not confirm overwrites and this would be an issue for
'the client I am writing this for. If this is not an
' issue for you, just delete the entire section or
' simply comment it out.
PauseTime = 1
Start = Timer
Do While Timer < Start + PauseTime
Loop
Finish = Timer
'''''''''''''''''''''''''''''''''' '''''''
Next dblLoop
End If
100
Next
ExitSub:
Set objAttachments = Nothing
Set objMessage = Nothing
Set objHighlighted = Nothing
Set objOutlook = Nothing
End Sub
' This entire section of code was provided to me by Sue.
' This is NOT my work and I am NOT taking credit for it.
'''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
Function GetFolder(FolderPath)
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim aFolders
Dim fldr
Dim i
Dim objNS
On Error Resume Next
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")
'get the Outlook objects
'use intrinsic Application object in form script
Set objNS = Application.GetNamespace("MAPI")
'set the root folder
Set fldr = objNS.Folders(aFolders(0))
'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err <> 0 Then Exit Function
Next
Set GetFolder = fldr
' dereference objects
Set objNS = Nothing
End Function
Sub Save_att()
End Sub