Senhores boa tarde!!!!

Fiz uma adaptação de um codigo para envio automatico de um anexo junto com o email, na realidade duas situações um em pdf para o cliente que esta ok, e a outra versão em uma planilha em excel só que a mesma não esta anexando ao email e não retorna erro nenhum, seria possivel alguem lançar uma luz ....
segue em anexo a planilha
o codigo utilizado é este :

If Range("f2").Value = "" Then
   
    MsgBox "Campo Fornecedor deve estar preenchido"
    Exit Sub
    
 End If
 


If Range("m4").Value = "" Then

    
    MsgBox "Campo Ordem Ferramentaria deve estar preenchido"
    Exit Sub
        
End If
    


If MsgBox("Você realmente deseja enviar a Solicitação de orçamento para o FORNECEDOR", 36, "Envio de Orçamento") = vbYes Then




    Dim Caminho As String
    Dim Data As String
    Dim var_Mensagem
    Dim Nome As String
    Dim UltimaLinha As Long
Dim Mail As New Message
Dim destinatario As String
Dim remetente As String
Dim titulo As String
Dim senha As String
Dim scorpo As String

remetente = Sheets("Planilha Orçamento").Range("a1")
destinatario = Sheets("Planilha Orçamento").Range("f1")

senha = InputBox("Digite sua senha")

titulo = Sheets("Planilha Orçamento").Range("g1")


Dim Config As Configuration: Set Config = Mail.Configuration

Config(cdoSendUsingMethod) = cdoSendUsingPort
Config(cdoSMTPServer) = "smtp.gmail.com"
Config(cdoSMTPServerPort) = 25
Config(cdoSMTPAuthenticate) = cdoBasic
Config(cdoSMTPUseSSL) = True
Config(cdoSendUserName) = remetente
Config(cdoSendPassword) = senha
Config.Fields.Update


scorpo = "Srs. Bom Dia!!!"
scorpo = scorpo & "<p/>"
scorpo = scorpo & "<p/>" & "Segue em Anexo orçamento, assim que possivel aguardo retorno."
scorpo = scorpo & "<p/>" & "Sds " & Sheets("Planilha Orçamento").Cells(4, 9).Value ' celula contem o nome do programador

Mail.To = destinatario
Mail.From = Config(cdoSendUserName)
Mail.Subject = titulo
Mail.HTMLBody = scorpo

'Anexar planilha no email --- 1454 indica um anexo de arquivo


Dim CurrentSheet As Worksheet
Dim WKB As Workbook
Dim Nome1, NovoNome As String  ' Declara a variável como string ( texto)


Application.ScreenUpdating = False

        Nome1 = Sheets("Planilha Orçamento").Range("g1")

        Set CurrentSheet = Worksheets("fornecedor")

        On Error Resume Next

        'copia todas as células da planilha ativa
        CurrentSheet.Cells.Copy

        'Cria a Nova PASTA (ARQUIVO)
        Set WKB = Workbooks.Add

        'cola somente os valores na planilha Ativa da nova Pasta,
        'sem formulas e mantenndo a formatação
        With ActiveSheet.Range("A1")
          .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          .PasteSpecial Paste:=xlFormats
        End With

        Application.CutCopyMode = False

        'Define os Novos Nomes - Planilha(ABA) e Pasta(Arquivo)
        NovoNome = Nome1

        'Renomeia a planilha nova com
        'o Nome que estava em G1
        With ActiveSheet
            .Name = NovoNome
            .Range("A1").Select
        End With

        Range("A1").Select

        'Enibe a mensagem se a pasta já existir
        'Com essa instrução a Pasta será substiutida sem questionamento
        Application.DisplayAlerts = False

        'Salva a Nova Pasta no Diretorio abaixo com o mesmo Nome
        'Alterem o mesmo conforme o endereço que querem
        
        WKB.SaveAs ThisWorkbook.Path & "" & NovoNome & ".xlsx"
        
        Caminho = ThisWorkbook.Path & "" & NovoNome & ".xlsx"
        

Mail.AddAttachment Caminho
        
   

On Error GoTo Trata_Erro

    Mail.Send
            
    MsgBox "Orçamento Enviado com Sucesso!!!"
                    
Else
   
Exit Sub
    
End If
        


    Exit Sub

Trata_Erro:
            MsgBox "Senha fornecida não confere."