Notifications
Clear all

Salvar, anexar e enviar Macro por e-mail - Erro com VB

3 Posts
2 Usuários
0 Reactions
933 Visualizações
(@gabach)
Posts: 4
New Member
Topic starter
 

Olá!

Estou fazendo uma Macro estilo formulário, que irá se auto anexar e auto enviar por e-mail para usuários mediante ativada. Minha ideia é que, quando enviada, ela também contenha os códigos nos módulos e sheets porque os usuários que irão receber precisam repassa-la adiante e provavelmente não terão acesso à planilha original.

Também adicionei um código em uma sheet para automatizar hide/unhide de linhas...depois que adicionei esse código, não consigo mais salvar e anexar a planilha no email. A mensagem que recebo é "Os recursos a seguir não podem ser salvos em pastas de trabalho sem macro: Projeto do VB. Para salvar um arquivo com esses recursos, clique em Não e escolha um tipo de arquivo habilitado para macro na lista Tipo de Arquivo. Para continuar salvando como pasta de trabalho sem macro, clique em Sim."

Segue abaixo o código de envio de email, que está em um módulo, e também o código automatizado de hide/unhide linhas, que está na sheet. Esse código de anexar e enviar por email estava funcionando perfeitamente, mas depois que adicionei o código de automatização para hide/unhide linhas abaixo, ele começou a dar esse código de erro acima.

Código e-mail:

Sub RP()

  
    '******************************************************
    'Set email details; Comment out if not required
    MailTo = "fulano@fulano.com"
    MailSub = Range("form") & ": " & Range("Subject")
    MailTxt = "I have attached " & Range("form") & Range("Subject")
    '******************************************************
     
     'Turns off screen updating
    Application.ScreenUpdating = False

         'Turns off screen updating
    Application.ScreenUpdating = False
     
      'Makes a copy of the active sheet and save it to
     'a temporary file
    ActiveSheet.Copy
    Set WB = ActiveWorkbook
    FileName = Range("form") & "_" & Range("Subject")
    On Error Resume Next
    Kill "C:" & FileName
    On Error GoTo 0
    WB.SaveAs FileName:=FileName
    
    'Creates and shows the outlook mail item
    Set objUserProperty = AOMailMsg.UserProperties.Add("TITUSAutomatedClassification", 1)
    objUserProperty.Value = "TLPropertyRoot=ABCDE;Classification=Internal;Registered to:My Companies;"
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        .To = MailTo
        .Cc = MailCC
        .Bcc = MailBCC
        .Subject = MailSub
        .Body = MailTxt
        .Attachments.Add WB.FullName
        .Save
        .Display
    End With
    
     'Deletes the temporary file
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False
     
     'Restores screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing

     
End Sub

Hide/Unhide linhas automaticamente

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("form").Value = "Requisição de Pessoal" Then
        Rows("27:61").EntireRow.Hidden = False
        Rows("14:26").EntireRow.Hidden = True
        Rows("62:86").EntireRow.Hidden = True
    ElseIf Range("form").Value = "Requisição de Desligamento" Then
        Rows("27:61").EntireRow.Hidden = True
        Rows("62:86").EntireRow.Hidden = True
        Rows("14:26").EntireRow.Hidden = False
    ElseIf Range("form").Value = "Promoção" Then
        Rows("14:61").EntireRow.Hidden = True
        Rows("62:86").EntireRow.Hidden = False
       
    End If

End Sub

Agradeço muito qualquer ajuda!

Gabrielle

 
Postado : 31/08/2015 3:40 pm
(@gabach)
Posts: 4
New Member
Topic starter
 

Pessoal alguma ajuda sobre isso?

Obrigada!

 
Postado : 08/09/2015 12:42 pm
(@messiasmbm)
Posts: 223
Estimable Member
 

Primeiro passo é saber se vc tem Outlook instalado e configurado.
Procure algo sobre isso OutlookConnector.exe faça download e instale.

 
Postado : 11/09/2015 5:31 am