Excel macro para salvar arquivo recebido

[salvir]

Caros,

 

Tenho um arquivo em que é enviado por e-mail, quando o recebedor abre o arquivo ele clica em um botão de macro e com o código abaixo deveria salvar o arquivo para depois enviar novamente por e-mail. Entretanto, tem momentos ou algum usuário que não salva o arquivo.

Alguém saberia me dizer porque isso ocorre?

 

On Error Resume Next
   

Dim Caminho As String 'declaracao da variável caminho
    Caminho = ThisWorkbook.Path & "\"
    ActiveWorkbook.SaveAs Filename:=Caminho & [G238].Value & ".xlsb"

 

[Basole]

Nao sei qual evento esta usando esta macro, mas tente usar o evento Workbook_BeforeClose.

que faz o salvamento automatico caso o usuario nao confirme o salvamento:

Cole o cod abaixo no editor de EstaPasta_de_Trabalho.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Caminho As String 'declaracao da variável caminho
Dim sPlan As String       'declaracao da variavel aba
 
sPlan = Sheets("Plan1").[G23].Value ' Altere se necessario o nome da respect. aba

If sPlan = "" Then MsgBox " Preencha dos dados da celula G238": Exit Sub

    Caminho = ThisWorkbook.Path & "\" & sPlan
    ActiveWorkbook.SaveAs Filename:=Caminho & ".xlsb", FileFormat:=50
End Sub

 

[salvir]

 

Muito obrigado pela ajuda.

O que estou fazendo é conforme abaixo. O que preciso é que o usuário abra o arquivo que receberá por email, ele vai avaliar e se OK ele clica em um botão de macro e então salva o arquivo e prepara o email.

O que tenho percebido é que em alguns usuários não salva o arquivo, mas todos os outros procedimentos funciona normalmente.

Sub EnviarEmail()

Dim Condição As String
    Condição = Sheets("Menu").Range("J53").Value


Select Case Condição

Case 1
   Dim Msg As String
       Msg = Sheets("Menu").Range("I58").Value
      
       MsgBox Msg, vbCritical, "Price Approval"
       Sheets("PriceApproval").Select
       Range("I3").Select
   
Case 2

    Application.ScreenUpdating = False

'Elimina as fórmulas na plan Menu
    Range("E53:I327").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("A1").Select

'Salva o arquivo
    On Error Resume Next
    Dim Caminho As String 'declaracao da variável caminho
    Caminho = ThisWorkbook.Path & "\"
    ActiveWorkbook.SaveAs Filename:=Caminho & [G82].Value & ".xlsb"
 
'Envio do email   
    Dim outlook As Object
    Dim outlookMail As Object

    Set outlook = CreateObject("Outlook.Application")
    Set outlookMail = outlook.CreateItem(0)

    Dim Para, Cópia, Assunto, Texto As String
    Para = Range("mSP").Value
    Cópia = Range("mSC").Value
    Assunto = Range("mSA").Value
    Mensagem = Range("mMS").Value
   
    With outlookMail
        .To = Para
        .CC = Cópia
        .Subject = Assunto
        .Body = Mensagem
        .Attachments.Add ThisWorkbook.FullName
        .Display
    End With

End Select

End Sub