Hello everyone. I have been working on this code for a while and the code below works. The only problem is that I want this code to download the attachment and rename the attachment with the subject line. I have found many ways to do this, but no program has actually worked yet. I either get an error, or no action, or it downloads the attachment as some unknown file type. Can anyone help with the code below and make it rename the downloaded attachment to the subject line? Thank you!

Option Explicit
Sub Main_Macro()

End Sub
Call sub_AESheets '
Call Sub_SALSheets '

Sub AESheets()
On Error Resume Next
'create the folder if it doesnt exists:
Dim fso, ttxtfile, txtfile, WheretosaveFolder
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders

'MsgBox objFolders("mydocuments")
'ttxtfile = objFolders("mydocuments")

'Set fso = CreateObject("Scripting.FileSystemObject")
'Set txtfile = fso.CreateFolder(ttxtfile & "\AETimesheets")
'Set fso = Nothing

'Save directory (CHANGE TO YOUR OWN DIRECTORY)
WheretosaveFolder = "\\newday.com\maplelawn\jbeitler\Documents\AEtimesheets"

On Error GoTo AESheets_err
' Declare variables
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)

'If you have several accounts, the Downloads folder should be in the Outlook Data File Account
Set Inbox = Inbox.Folders("AEtimesheets")

' added the option to select whic folder to export
'Set Inbox = ns.PickFolder

'to handle if the use cancalled folder selection
If Inbox Is Nothing Then
MsgBox "You need to select a folder in order to save the attachments", vbCritical, _
"Export - Not Found"
Exit Sub
End If

''''


i = 0
' Check Inbox for messages and exit of none found
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the selected folder.", vbInformation, _
"Export - Not Found"
Exit Sub
End If
' Check each message for attachments
For Each Item In Inbox.Items
' Save any attachments found
For Each Atmt In Item.Attachments
' This path must exist! Change folder name as necessary.
' FileName = "\\newday.com\maplelawn\jbeitler\Documents\aetimesheets" & Atmt.FileName
'if want to add a filter:
'If Right(Atmt.FileName, 3) = "xls" Then

FileName = WheretosaveFolder & "\" & Atmt.FileName + i
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item
' Show summary message
If i > 0 Then
MsgBox "There were " & i & " attached files."
Else
MsgBox "There were no attachments found in any mails.", vbInformation, "Export - Not Found"
End If
' Clear memory
AESheets_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
' Handle errors
AESheets_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: AESheets" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume AESheets_exit
End Sub

Sub SALSheets()
On Error Resume Next
'create the folder if it doesnt exists:
Dim fso, ttxtfile, txtfile, WheretosaveFolder
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders

'MsgBox objFolders("mydocuments")
'ttxtfile = objFolders("mydocuments")

'Set fso = CreateObject("Scripting.FileSystemObject")
'Set txtfile = fso.CreateFolder(ttxtfile & "\SALTimesheets")
'Set fso = Nothing

'Save directory (CHANGE TO YOUR OWN DIRECTORY)
WheretosaveFolder = "\\newday.com\maplelawn\jbeitler\Documents\SALtimesheets"

On Error GoTo SALSheets_err
' Declare variables
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)

'If you have several accounts, the Downloads folder should be in the Outlook Data File Account
Set Inbox = Inbox.Folders("SALtimesheets")

' added the option to select whic folder to export
'Set Inbox = ns.PickFolder

'to handle if the use cancalled folder selection
If Inbox Is Nothing Then
MsgBox "You need to select a folder in order to save the attachments", vbCritical, _
"Export - Not Found"
Exit Sub
End If

''''


i = 0
' Check Inbox for messages and exit of none found
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the selected folder.", vbInformation, _
"Export - Not Found"
Exit Sub
End If
' Check each message for attachments
For Each Item In Inbox.Items
' Save any attachments found
For Each Atmt In Item.Attachments
' This path must exist! Change folder name as necessary.
' FileName = "\\newday.com\maplelawn\jbeitler\Documents\SALtimesheets" & Atmt.FileName
'if want to add a filter:
'If Right(Atmt.FileName, 3) = "xls" Then

FileName = WheretosaveFolder & "\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item
' Show summary message
If i > 0 Then
MsgBox "There were " & i & " attached files."
Else
MsgBox "There were no attachments found in any mails.", vbInformation, "Export - Not Found"
End If
' Clear memory
SALSheets_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
' Handle errors
SALSheets_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: SALSheets" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume SALSheets_exit
End Sub