Propósito

✔ Programação GLOBAL® - Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog devem ser tratados como consultoria freelance. Queiram contatar-nos: brazilsalesforceeffectiveness@gmail.com | ESTE BLOG NÃO SE RESPONSABILIZA POR QUAISQUER DANOS PROVENIENTES DO USO DOS CÓDIGOS AQUI POSTADOS EM APLICAÇÕES PESSOAIS OU DE TERCEIROS.

.: Vitrine

Carregando artigos...

Views

Mostrando postagens com marcador message. Mostrar todas as postagens
Mostrando postagens com marcador message. Mostrar todas as postagens

VBA Outlook - Envia uma cópia oculta automaticamente para um e-mail.

Inline image 1



O que é o fenômeno chamado BIG DATA?



Desenvolvermos um código que fique incubado no nosso MS Outlook para garantir que todos os e-mails que forem enviados através dele, automaticamente faça uma cópia deste conteúdo para outro endereço específico pode ser conseguido através da programação VBA.


Se você for menos experiente no uso de automação, talvez esteja se perguntando porque é que iria desejar implementar um código assim no seu MS Outlook.  É verdade que talvez não precise deste código agora, mas certamente o utilizará alguma vez na vida, reflita nas duas situações abaixo:

Digamos que deseje auditar todas as mensagens que estão sendo enviadas através do seu MS Outlook, recebendo uma cópia de qualquer mensagem que enviarem. Como fazer isso?

Quem sabe, queira guardar em uma conta de e-mail externa, o conteúdo de todos os e-mails enviados diariamente da sua máquina, através do MS Outlook, para garantir que nada se perca caso hajam problemas com o seu servidor local de e-mails, como fazer isso?


Private Sub Application_ItemSend (ByVal Item As Object, _
                                 Cancel As Boolean)
    '        Author: André Luiz Bernardes - bernardess@gmail.com
    '          Date: 05/08/13 - 16:03
    '   Application: OutlookFunctionalities®
    ' Functionality: Envia uma cópia oculta automaticamente para um e-mail.
    
    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next
    
    Let strBcc = "bernardess@gmail.com"

    Set objRecip = Item.Recipients.Add(strBcc)
    
    Let objRecip.Type = olBCC
    
    If Not objRecip.Resolve Then
        Let strMsg = "O Outlook não consegue enviar a mensagem para este endereço de e-mail BCC. " & _
                 "Deseja continuar enviando a mensagem?"
        Let res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                "Não consigo decifrar este endereço Bcc")
        
        If res = vbNo Then
            Let Cancel = True
        End If
    End If

    Set objRecip = Nothing
End Sub


brazilsalesforceeffectiveness@gmail.com

✔ Brazil SFE®Author´s Profile  Google+   Author´s Professional Profile   Pinterest   Author´s Tweets

VBA Access - Alterando a Barra de Status - Message in Status bar




Sim, alterar a mensagem que é mostrada na Barra de Status da sua aplicação MS Access pode ser algo que desejará um dia. Como? Segue código abaixo.

Function ChageStatusBar
     Dim nStatus As Variant
       Dim nMess As String

     Let nMess = "Copyright 2012 - A&A - In Any Place"

     ' Mostra a mensagem.
     Let nStatus = SysCmd(acSysCmdSetStatus, nMess) 


     ' Limpa a mensagem.
     Let nStatus = SysCmd(acSysCmdClearStatus) 


Tags: VBA. Access, Bar, StatusBar, message, mensagem, barra de status,



VBA Tips - Use Caixas de Mensagens melhores com botões e ícones adicionais - Enhance Message Boxes with additional Buttons and Icons

A função MsgBox contém um argumento opcional, Buttons, que nos permite colocar botões adicionais, além de ícones nas nossas caixas de mensagens, especificando um valor VbMsgBoxStyle

Para obter uma lista de valores VbMsgBoxStyle, consulte o Object Browser VBA.

Aqui está um exemplo de como colocar botões adicionais e ícones nas suas caixas de mensagens:

Public Sub CustomMessageBoxes()

    ' Purpose: Demonstrates how to work with custom message boxes.

    Dim iResponse As Integer
    
    MsgBox Prompt:="Abort/Retry/Ignore (Ignore Default)", _
        Buttons:=vbAbortRetryIgnore + vbDefaultButton3

    MsgBox Prompt:="Critical", Buttons:=vbCritical

    MsgBox Prompt:="Exclamation", Buttons:=vbExclamation

    MsgBox Prompt:="Information", Buttons:=vbInformation

    MsgBox Prompt:="OK/Cancel", Buttons:=vbOKCancel

    MsgBox Prompt:="Question", Buttons:=vbQuestion

    MsgBox Prompt:="Retry/Cancel", Buttons:=vbRetryCancel

    MsgBox Prompt:="Yes/No", Buttons:=vbYesNo

    MsgBox Prompt:="Yes/No with Information", _
        Buttons:=vbYesNo + vbInformation

    MsgBox Prompt:="Yes/No with Critical and Help", _
        Buttons:=vbYesNo + vbCritical + vbMsgBoxHelpButton

    ' Determina cada botão selecionado pelo usuário.
    Let iResponse = MsgBox(Prompt:="Click Yes or No.", _
        Buttons:=vbYesNo + vbCritical)

    Select Case iResponse
        Case vbYes
            MsgBox Prompt:="You clicked Yes."
        Case vbNo
            MsgBox Prompt:="You clicked No."
    End Select

End Sub


Tags: VBA, Tips, enhance, message, boxes, additional, buttons, Icons, caixa de mensagens, ícones, botões, VBA Object Browser, VbMsgBoxStyle, VbMsgBoxStyle



VBA Outlook - Envie todas as suas mensagens por e-mails como Bcc, automaticamente.

Inline image 2

O MS Outlook tem uma regra quando enviamos mensagens para outra pessoa como Cc, mas não há nada equivalente para mensagens enviadas como BCC (ou CCo, Oculta).

Utilizaremos o evento Application.ItemSend, que será acionado quando um usuário for enviar uma mensagem.

A versão ideal para se fazer isso é a partir do MS Outlook 2003. Ela usa objetos exclusivamente Outlook e inclui manipulação de erro para evitar problemas com um endereço inválido Bcc.

Ela usa objetos exclusivamente MS Outlook e inclui manipulação de erro para evitar problemas com um endereço inválido Bcc

Coloque esse código VBA no módulo interno de ThisOutlookSession:


1ª Versão:

Private Sub Application_ItemSend (ByVal Item As Object, Cancel As Boolean)
    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next

    strBcc = "bernardess@gmail.com"

    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC

    If Not objRecip.Resolve Then
        strMsg = "Não posso enviar esta mensagem oculta. " & _
                 "Deseja continuar enviando a mensagem?"

        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                "Não posso enviar esta mensagem oculta.")

        If res = vbNo Then
            Cancel = True
        End If
    End If

    Set objRecip = Nothing
End Sub

A razão pela qual este método não é adequado para as versões anteriores do MS Outlook 2003 é porque ele dispara um alerta de segurança devido ao uso do Recipients.Add

Você pode evitar avisos de segurança, simplesmente definindo a propriedade Item.Bcc para o endereço desejado, mas terá dois problemas. Primeiro, iria retirar os destinatários Bcc que o usuário já tivesse adicionado. Além disso, em algumas configurações do MS Outlook, mesmo se você usar um endereço SMTP apropriado, obteria um erro, e o  MS Outlook  não enviaria a mensagem.


2ª Versão:

Esta versão utiliza a mesma técnica básica da 1ª, apenas adiciona a biblioteca de terceiros Outlook Redemption para evitar avisos de segurança das versões anteriores ao MS Outlook 2003 e, caso o beneficiário não possa ser resolvido, para mostrar ao usuário uma caixa de diálogo de resolução dos nomes.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    ' Requires a reference to
    ' the SafeOutlook library (Redemption.dll)

    Dim objMe As Redemption.SafeRecipient
    Dim sMail As Redemption.SafeMailItem

    On Error Resume Next
    
    Set sMail = CreateObject("Redemption.SafeMailItem")

    Item.Save

    sMail.Item = Item
    Set objMe = sMail.Recipients.Add ("bernardess@gmail.com")
    objMe.Type = olBCC

    If Not objMe.Resolve(True) Then
        Cancel = True
    End If
    
    Set objMe = Nothing
    Set sMail = Nothing
End Sub

Reference:
TagsVBA, Outlook, Outlook 2003, send, message, mensagem, Bcc, ThisOutlookSession, automation

VBA Excel - Caixa de Diálogo - Dialog Box

Inline image 1

Sim, e porque não voltar ao básico? Perfect! 
Revemos o princípio e melhoramos o presente com excelentes perspectivas para o futuro.

Pronto para COPIAR e COLAR - Abra a caixa de diálogo e escolha o arquivo que desejar para o propósito que preferir. 

Primeira opção

Não é raro precisarmos pedir alguma informação para o usuário. Qual a melhor maneira de fazer isso se não usar uma caixa de diálogo?

Sub UserInput()

Dim iReply As Integer

    iReply = MsgBox(Prompt:="Do you wish to run the 'update' Macro", _
            Buttons:=vbYesNoCancel, Title:="UPDATE MACRO")
            
    If iReply = vbYes Then

        Run "UpdateMacro"

    ElseIf iReply = vbNo Then

       'Do Other Stuff

    Else 'They cancelled (VbCancel)

        Exit Sub

    End If

End Sub 

Segunda opção
InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])
Agora suponhamos que você queira submeter os dados entrados a uma análise prévia e direcionamento...Ahhh, isso seria interessante não é mesmo? Tente isso:

Sub GetUserName()

Dim strName As String


    strName = InputBox(Prompt:="Seu nome,por favor.", _
          Title:="Digite o seu Nome", Default:="Digite seu nome aqui")
          

        If strName = " Digite seu nome aqui " Or _
           strName = vbNullString Then

           Exit Sub

        Else

          Select Case strName

            Case "André"

                'Faça as coisas para o perfil André

            Case "Luiz"

                'Faça as coisas para o perfil Luiz

            Case "Bernardes"

                'Faça as coisas para o perfil Bernardes

            Case Else

                'Faça as coisas para uns perfis mais genéricos 

          End Select

        End If

End Sub


Terceira opção


Dim strFilePath As String, strPath As String
Dim fdgO As FileDialog, varSel As Variant

MsgBox "A tabela não está correta, " &
_
"e o arquivo de dados não pôde ser achado na respectiva pasta: " & _
strPath & ". Por favor,localize a pasta que contenha dados de exemplo " & _
".: Dialog.", vbInformation, gstrAppTitle

Set fdgO = Application.FileDialog(msoFileDialogFilePicker)
With fdgO

.AllowMultiSelect = False

.Title = "Localize a pasta com dados de exemplo"

.ButtonName = "Escolha"

.Filters.Clear

.Filters.Add "All Files", "*.*", 1

.FilterIndex = 1

.InitialFileName = strPath

.InitialView = msoFileDialogViewDetails

If .Show = 0 Then
MsgBox "Houve falha para selecionar o arquivo correto. ATENÇÃO: " & _
"Você talvez não tenha aberto uma tabela conectada a aplicação. " & _
" Você pode re-abrir este formulário ou " & _
"inicie o formulário, tentando novamente.", vbCritical,
gstrAppTitle

Let CheckConnect = False

Exit Function
End If

Let strFilePath = .SelectedItems(1)
End With

Let strPath = Left(strFilePath, InStrRev(strFilePath, "\") - 1)
Let varSel = AttachAgain(strPath)



Quarta opção


Sub GetDat () 
      ' Posiciona num local  específico.
      ChDrive "C: \" 
      ChDir "C: \ Teste \" 

      Let FileToOpen = Application.GetOpenFilename _
      (Title:="Por favor escolha o arquivo a importar:", FileFilter:="Arquivos Excel *.xls (*.xls),")''

      If FileToOpen = False Then

            MsgBox "Arquivo não especificado!", vbExclamation, ":. A&A"

            Exit Sub
      Else
            Workbooks.Open Filename:=FileToOpen
      End If
End Sub


André Luiz Bernardes

TagsVBA, Dialog box, message, mensagem, caixa de diálogo

diHITT - Notícias