Macro error 'Cannot save the attachment. Don't have appropriate permission' - vba

Question

I have a button enabled macro in Outlook that looks through a shared inbox I have access to, finds Excel attachments in each mail item and then extracts them to a location on the network, creating a folder name with details of the subject of the email if it does not already exist.
When I first ran the macro about 3 months ago, I didn't encounter any error messages. However, running it again today brought up the following error message:
'Cannot save the attachment. You don't have the appropriate permission to perform this operation'
If I save the attachment to the location I want on the network, I have no problem doing so.
I used a msgbox prompt in the code to tell me what the attachment fullpath is before saving it. I'm not sure if this means anything but the atmt.pathname just brings up a blank messagebox.
What might be the issue? it seems as if the attachment I'm trying to save isn't actually there.
I have Outlook 2007 with Microsoft Exchange.
' Declare variables
Dim ns As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim filename As String
Dim i As Integer
Dim iLoop As Integer
Dim ext As String
Dim Items As Outlook.Items
Dim counter
Dim Countofiloop, NumberOfInboxItems
Dim CategoryNameDetected As Boolean
Dim moveEmail As Boolean
Dim EmailSubject As String
Dim SiteNames As String
Dim targetRoute As String
Dim targetPath As String
' -------------------------- HERE SETS THE ROUTE TARGET PATH --------------------
targetRoute = "FolderPath\"
' -------------------------------------------------------------------------------
Dim Progress
Set ns = GetNamespace("MAPI")
Set Inbox = ns.Folders("Shared").Folders("Inbox")
Set Item = Inbox.Items
' Before the loop starts, set the vars
' Check Inbox for messages and exit if none found
If Inbox.Items.count = 0 Then
MsgBox "There are no messages to scan in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' Check each message for attachments
NumberOfInboxItems = Inbox.Items.count
TotalInboxItems = NumberOfInboxItems
counter = 0
'========================== L O O P S T A R T S H E R E ===============
For i = 1 To NumberOfInboxItems
' assign email subject to as string
Set Item = Inbox.Items.Item(i)
EmailSubject = Item.Subject
counter = counter + 1
KPISorterForm.ListBox1.AddItem "Examining email " & counter & " out of " & Inbox.Items.count & " " & EmailSubject
DoEvents
' WHAT IS IT???----SET THE FILE PATH----------------------------------------
' does it have four digits in the subject line at the beginning?
If IsNumeric(Left(EmailSubject, 4)) = True And InStr(1, EmailSubject, "for") > 0 Then
SiteNames = Left(EmailSubject, InStr(1, EmailSubject, "for") - 2)
' Trim the string if ending with a space character
Do Until Not Right(SiteNames, 1) = " "
SiteNames = Left(SiteNames, Len(SiteNames) - 1)
Loop
SiteNames = Replace(SiteNames, " ", "")
' Save the attachment to specified location
For Each Atmt In Item.Attachments
' This filename path must exist! Change folder name as necessary.
' get here the extension
ext = Atmt.filename
ext = Right(ext, Len(ext) - InStrRev(ext, ".") + 1)
If Left(ext, 3) = ".xl" Then
targetPath = targetRoute & SiteNames
' SAVE ATTACHMENT
If testDir(targetPath) = False Then
KPISorterForm.ListBox1.AddItem "Creating directory " & targetPath
DoEvents
MkDir targetPath
End If
MsgBox Atmt.PathName
Atmt.SaveAsFile targetPath & "\" & SiteNames & ext
KPISorterForm.ListBox1.AddItem "Saving Item " & targetPath & "\" & SiteNames & ext
DoEvents
AttachmentsSaved = AttachmentsSaved + 1
moveEmail = True
End If
Next Atmt
End If
KPISorterForm.ListBox1.ListIndex = KPISorterForm.ListBox1.ListCount - 1
Next i
' Clear memory
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Set appOl = Nothing
Set myDestFolder = Nothing
HomeUserFormOutlook.ProgressFrame.Visible = False
HomeUserFormOutlook.ProgressBar.Width = 0
HomeUserFormOutlook.ProgressBar.Visible = False
DoEvents

Answer 1

Did you set your file attributes to vbNormal? Chances are it's in another mode like hidden or read-only....

Answer 2

When you specify the path in SaveAsFile(Path)
The path needs to include the name of the file that you are saving, so if you want the file to be saved with the same name use the .DisplayName property of the attachment item.