vh, fiquei em duvida do seguinte, a rotina cria a planilha, Salva, mas no final da rotina a mesma é Deletada, ou seja não fica a cópia.

Então para que não Salve é só tirar a opção de SaveAs, assim a mesma é criada e como não salvamos ela não permanece no pc.

Faça s testes e rtorne.

[]s

Mauro,

Encontrei esse codigo na web que me ajuda bastante no que preciso mas ele dá erro de tempo de depuração, consegue me ajudar a diagnosticar o pq?

http://www.vbaexpress.com/kb/getarticle.php?kb_id=326

Caso não consiga ver:

Sub EmailWithOutlook()
'Variable declaration
Dim oApp As Object, _
oMail As Object, _
WB As Workbook, _
FileName As String

'Turn off screen updating
Application.ScreenUpdating = False

'Make a copy of the active sheet and save it to
'a temporary file
ActiveSheet.Copy
Set WB = ActiveWorkbook
FileName = "Temp.xls"
On Error Resume Next
Kill "C:" & FileName
On Error GoTo 0
WB.SaveAs FileName:="C:" & FileName

'Create and show the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a recipient
'.To = "[email protected]"
'Uncomment the line below to hard code a subject
'.Subject = "Look at my workbook!"
.Attachments.Add WB.FullName
.Display
End With

'Delete the temporary file
WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False

'Restore screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub

VH, antes de mais nada deixa eu corrigir uma menção que fiz em seu código anterior :
não Salve é só tirar a opção de SaveAs, assim a mesma é criada e como não salvamos ela não permanece no pc
Na realidade se remover esta instrução, seria o mesmo que não ter criado o novo book, ou seja ele existe como temporário com o nome criado com a instrução Workbooks.Add ficando como "Pasta1,2,3...", então se não o salvarmos, ou expecificando um nome ou utilizando o nome padrão que é atribuido, não temos como anexa-lo, então não elimine a linha que eu disse.

Quanto a esta outra rotina, eu acredito que o erro é devido ao caminho (Path), no teste que fiz aqui no serviço, não nos é permitido criar qualquer tipo de arquivo em "C:", isto já é definido nas diretivas de rede, então me dá um erro de caminho não acessivel.

Apesar deta rotina praticamente efetuar a mesma coisa que a postada anteriormente, na outra o caminho utilizado é definido em ThisWorkbook.Path, e nesta você tem de expecificar impicitamente na rotina em :

On Error Resume Next - Esta Linha é para evitar o erro se o arquivo não exisitir quando Deletamos o mesmo na linha abaixo
Kill "C:" & FileName - se existir o arquico em C: ele é deletado, se não,

Ele é salvo no mesmo caminho.
WB.SaveAs FileName:="C:" & FileName

Depois que acertei o caminho para a pasta em que eu posso salvar documentos, a rotina correu sem erros.

Então, veja o caminho do arquivo em seu PC, ou tambem se o nome que você definiu não tem algum erro.
[]s

Mauro,

Vc consegue acessar emails particulares? Te mandei no seu email

[]s

Mauro!

Pode postar o codigo corrigido aqui caso consiga!

Rgs

Vh, se enviou para [email protected], até o momento não recebi nada.

Agora quanto a arrumar o código, foi como eu disse acima, eu só acertei o endereço (Path) definido em :
Kill "C:" & FileName; para
Kill "C:mauro.coutinhoMeus documentosmvcmail" & FileName

e em :
WB.SaveAs FileName:="C:" & FileName; para
WB.SaveAs FileName:="C:mauro.coutinhoMeus documentosmvcmail" & FileName

Você chegou a baixar o exemplo no site que indicou ?

De qualquer forma envie o modelo que dou uma olhada.

[]s

Eu mandei pro seu hotmail!

Quer que eu mande pro planilhando! Enviando agora msm!

[]s

Eu mandei pro seu hotmail!
Quer que eu mande pro planilhando! Enviando agora msm!
[]s

Hotmail não tenho acesso aqui, agora já estou indo embora, assim que chegar em casa dou uma olhada.

[]s

Vh, baixei seu exemplo, só que não tive como testa-lo, pricipal motivo, eu não utilizo o Outlook nem tenho uma conta associada.

Depois, a rotina - Send_MailJust - que está em seu modelo é totalmente diferente das que foram postadas aqui no Forum, aquela que você postou o link, no serviço funcionou corretamente, la usamos o Outlook, cheguei a enviar a cópia da planilha para mim mesmo, só fazendo a alteração que lhe falei, no caminho do arquivo.
Em seu modelo original, me dá varias mensagens de erros devido a campos não preenchidos, tudo bem eliminei estas linhas somente para testar a parte que nos interessa, que é referente ao envio, sendo assim, como não expecificou qual erro ou erros está acontecendo, um que percebi e acredito que seja este, é que na rotina Send_MailJust você não tem a linha que copia e cria o novo arquivo com a aba, e sim você salva o arquivo inteiro com outro nome e depois tenta enviá-lo.

Adicione em sua rotina a instrução abaixo, antes da linha "Set WB = ActiveWorkbook" :
ActiveSheet.Copy

Como não utilizo o outlook, e não pretendo instala-lo, vou salvar uma cópia na v 2003 e testar no serviço amanhã, digo 2003 pois é a versão que tenho no serviço.

Vou ver see crio um exemplo somente com a rotina de envio e anexa-la no forum, assim outros colegas poderão olhar e dar uma ajuda.

[]s

Mauro obrigado,

Também utilizo a versão 2003, é so arquivo da rotina que ele gera com .xls

Na verdade eu uso boa parte daquelas rotinas, as validações são apenas de preenchimento pode excluir todas, mas o core do objeto mailEnvelope é o mesmo

Ou estou equivocado?

[]s

Consegui corrigir o funcionamento

Precisei utilizar apenas:

***********************************************************************************************************
Sub Send_MailJust()

Dim oApp As Object
Dim oMail As Object
Dim WB As Workbook
Dim FileName As String

' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = False

'Turn off screen updating
Application.ScreenUpdating = False

Sheets("Form-Just").Unprotect
ActiveSheet.Range("D10").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveSheet.Range("D12").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Form-Just").Range("A1:M70").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

ActiveSheet.Copy
Set WB = ActiveWorkbook
FileName = "Justificativa - " & ActiveSheet.Range("N16") & ".xls"
On Error Resume Next
Kill "C:Temp" & FileName
On Error GoTo 0
WB.SaveAs FileName:="C:Temp" & FileName

Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
' .Introduction = "Formulario de Justificativa - (" & ActiveSheet.Range("D20") & ")"
.To = ActiveSheet.Range("O12")
.CC = ActiveSheet.Range("O10")
.Subject = "[FORMULARIO DE JUSTIFICATIVA] - " & ActiveSheet.Range("D10") & ActiveSheet.Range("E13") & ActiveSheet.Range("F13")
.Attachments.Add WB.FullName
If MsgBox("Deseja realmente enviar a mensagem?", vbYesNo, "Notificação Automática") = vbNo Then
MsgBox "Envio cancelado pelo usuario!" & vbCrLf & "Feche o Arquivo sem Salvar!" & vbCrLf & "Em Seguida clique no Botão Cancelar!"
Exit Sub
Else
Application.DisplayAlerts = False
Sheets("Form-Just").Unprotect
.Send
Sheets("Form-Just").Protect , Contents:=True

WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False

End If
End With

Mensagem = MsgBox("Email Enviado com Sucesso, verifique seus itens enviados!", vbOKOnly, "Notificação Automática")
ActiveWorkbook.EnvelopeVisible = True
ActiveWorkbook.EnvelopeVisible = False
Sheets("Form-Just").Unprotect
Sheets("Form-Just").Protect , Contents:=True
Set oMail = Nothing
Set oApp = Nothing
Application.Quit
Application.DisplayAlerts = False
End Sub
***********************************************************************************************************

Quem quiser testar apenas crie a pasta C:Temp ou adicione uma rotine que crie o diretório, eu precisei criar porque tenhos restrições de acesso na máquina

[]s

Ola!

Testei aqui e não funcionou.... ta querendo depurar a linha 9
'Sheets("Form-Just").Unprotect

e o e-mail digitei ele nessa celula. To = ActiveSheet.Range("O12") é isso mesmo?

jp, o certo é colocar qual o erro, e não, "ta querendo depurar a linha 9", mas como você mostrou a linha, eu arrisco o palpite que você não tem uma Aba com o nome "Form-Just", pois nesta instrução estamos nos referenciando a esta aba e desprotegendo a mesma.

Altere na instrução para o nome de sua aba e veja se funciona.

[]s