Notifications
Clear all

barra de progressão

2 Posts
2 Usuários
0 Reactions
1,048 Visualizações
(@reinaldo_silva)
Posts: 38
Trusted Member
Topic starter
 

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
(@gamboaisrael)
Posts: 68
Trusted Member
 

Espero que esse tutorial do site do Benzadeus possa te ajudar:

http://www.ambienteoffice.com.br/office ... progresso/

Apesar de não ter um loop na rotina que você postou, acredito que dê pra adaptar.

Att.,

 
Postado : 25/01/2013 6:36 am