[Resolvido] VBA Excel - Salvar Anexos de uma subpasta, mover email e salvar anexos

Bom Dia Pessoal,

Eu juntei algumas rotinas de VBA para criar uma que atenda a minha necessidade, eu recebo 1 e-mail por dia com um anexo, sendo que, preciso salvar este arquivo em uma pasta de do computador, acontece que eu vou executar a Macro uma vez por semana, e o nome do arquivo é sempre o mesmo, considerando que terei recebido 7 arquivos da semana anterior (inclusive sab e dom), então, cada arquivo precisará ser salvo com um nome diferente. a Rotina abaixo faz oque eu preciso, porém, esta dando erro na hora de salvar, ou invés de salvar o .txt conforme anexo, ela salvar uma arquivo .jpg, e não consigo encontrar o erro, poderiam me ajudar?

Obrigado,

Sub Salvar_Emails()

Dim myNameSpace As Outlook.Namespace

Dim myInbox As Outlook.Folder

Dim myDestFolder As Outlook.Folder

Dim myItems As Outlook.Items

Dim myItem As Object

Dim Atmt As Attachment

Dim FileName As String

Dim Item As Object



Set myNameSpace = GetNamespace("MAPI&quot

Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("Teste&quot

Set myItems = myInbox.Items

Set myDestFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("Teste&quot.Folders("Lidos&quot

Set myItem = myItems.Find("[SenderName] = 'Josean Silverio'&quot



NomeAnexo = "Z01J14-RA00B.TXT"

NumSeq = 1

    While TypeName(myItem) <> "Nothing"

        For Each Atmt In myItem.Attachments

            FileName = "C:\Teste\" & Atmt.FileName

            Atmt.SaveAsFile FileName

            EditNome = Left(Now, 2) & Mid(Now, 4, 2) & Mid(Now, 7, 7) & Mid(Now, 15, 2) & Mid(Now, 18, 2) & NumSeq

            oldFileName = FileName

            DestinoArquivo = "C:\Teste\" & "\" & EditNome & ".TXT"

            newFileName = DestinoArquivo

            Set FSO = CreateObject("Scripting.FileSystemObject&quot

            FSO.MoveFile oldFileName, newFileName

            NumSeq = NumSeq + 1

        Exit For

            For iCount = 1 To 5

            Next iCount

        Next

        myItem.Move myDestFolder

        Set myItem = myItems.FindNext

    Wend



End Sub