caros eu pesquisei no nosso forum porém não consegui adaptar no meu modelo...segue o código abaixo para ver se conseguimos colocar uma barra de progresso...Reinaldo eu consegui fazer deletar o arquivo antigo...valeu pela ajuda o problema era de acesso mesmo depois eu coloco como resolvido no tópico.
Private Sub CommandButton1_Click()
Dim resultado As VbMsgBoxResult
resultado = MsgBox("Você está com o lotus notes aberto?", vbYesNo, "Salvar e enviar notes")
If resultado = vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"\BRGABS001G_DFIN_CTRLContabilidade e ReportsCadastro de contas contábeis2.Contas incluidas no ERP" & Cells(3, 10) & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
Range("j4").Select
Selection.Copy
Range("j4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Dim recip(25) As Variant
recip(0) = "[email protected]"
'recip(1) = "[email protected]"
'recip(4) = "[email protected]"
'recip(5) = "[email protected]"
'recip(6) = "[email protected]"
'recip(7) = "[email protected]"
'recip(8) = "[email protected]"
'recip(9) = "[email protected]"
'recip(10) = "[email protected]"
'recip(11) = "[email protected]"
'recip(12) = "[email protected]"
'recip(13) = "[email protected]"
'recip(13) = "[email protected]"
MailDoc.sendto = recip
MailDoc.Subject = "G:Contabilidade e ReportsCadastro de contas contábeis2.Contas incluidas no ERP" & Cells(3, 10) & ".xls"
BodyText = "Conta cadastrada no ERP. Favor atualizar suas UDCs no ERP"
MailDoc.Body = BodyText
'MailDoc.SaveMessageOnSend = SaveIt
'Set up the embedded object and attachment and attach it
'caminho = "\BRGABS001G_DFIN_CTRLContabilidade e ReportsCadastro de contas contábeis2.Contas incluidas no ERP" & Cells(3, 10) & ".xls"
'Set AttachME = MailDoc.CreateRichTextItem("Attachment")
'Set EmbedObj = AttachME.EmbedObject(1454, "", caminho, "Attachment")
'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items FOLDER
MailDoc.Send 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
Me.Hide
Else
resultado = MsgBox("Favor abrir e depois salvar novamente?", vbOKOnly, "Salvar e enviar notes")
End If
End Sub
Postado : 23/01/2013 2:46 pm