VBA OutLook - Enviando lembretes por e-Mail

Termo de Responsabilidade 

Como enviar lembretes por e-mail?

Este exemplo de código VBA Outlook envia as informações dos lembrentes para o e-mail que você especificar. Coloque esse código no módulo 

ThisOutlookSession.

Sub AppRem (ByVal Item As Object)

  Dim objMsg As MailItem

  

  Set objMsg = Application.CreateItem(olMailItem)

  

  Let objMsg.To = "bernardess@gmail.com"

  Let objMsg.Subject = "Reminder: " & Item.Subject

  

  Select Case Item.Class

     Case olAppointment '26

        objMsg.Body = "Start: " & Item.Start & vbCrLf & "End: " & Item.End & vbCrLf & "Location: " & Item.Location & vbCrLf & _

          "Details: " & vbCrLf & Item.Body

     Case olContact '40

        objMsg.Body = "Contact: " & Item.FullName & vbCrLf & "Phone: " & Item.BusinessTelephoneNumber & vbCrLf & _

          "Contact Details: " & vbCrLf & Item.Body

      Case olMail '43

        objMsg.Body = "Due: " & Item.FlagDueBy & vbCrLf & "Details: " & vbCrLf & Item.Body

      Case olTask '48

        objMsg.Body = "Start: " & Item.StartDate & vbCrLf & "End: " & Item.DueDate & vbCrLf & "Details: " & vbCrLf & 

Item.Body

  End Select

  objMsg.Send

  Set objMsg = Nothing

End Sub

Referências: 

Tags: VBA, Outlook, email, send

VBA Tips - Retirando acento - Remove and replace accent characters from a string.

Sei que você já tem uma função que retira acento, aliás, eu mesmo já postei uma solução destas por aqui. Mas sempre é bom olharmos para mais de uma solução:

Function ConvertAccent(ByVal inputString As String) As String

' http://www.vbforums.com/archive/index.php/t-483965.html

Const AccChars As String = _

      "²—­–ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ'"

Const RegChars As String = _

      "2---SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy'"

Dim i As Long, j As Long

Dim tempString As String

Dim currentCharacter As String

Dim found As Boolean

Dim foundPosition As Long

  tempString = inputString

  ' loop through the shorter string

 Select Case True

    Case Len(AccChars) <= Len(inputString)

      ' accent character list is shorter (or same)

     ' loop through accent character string

     For i = 1 To Len(AccChars)

        ' get next accent character

       currentCharacter = Mid$(AccChars, i, 1)

        ' replace with corresponding character in "regular" array

       If InStr(tempString, currentCharacter) > 0 Then

          tempString = Replace(tempString, currentCharacter, _

                               Mid$(RegChars, i, 1))

        End If

      Next i

    Case Len(AccChars) > Len(inputString)

      ' input string is shorter

     ' loop through input string

     For i = 1 To Len(inputString)

        ' grab current character from input string and

       ' determine if it is a special char

       currentCharacter = Mid$(inputString, i, 1)

        found = (InStr(AccChars, currentCharacter) > 0)

        If found Then

          ' find position of special character in special array

         foundPosition = InStr(AccChars, currentCharacter)

          ' replace with corresponding character in "regular" array

         tempString = Replace(tempString, currentCharacter, _

                               Mid$(RegChars, foundPosition, 1))

        End If

      Next i

  End Select

  ConvertAccent = tempString

End Function

Referências: 

Tags: VBA, Outlook, email, anexar, 


 

VBA Tips - Avalia o endereço do email - Validating An Email Address

Termo de Responsabilidade

Que tal validar um endereço de e-mail ou uma lista deles?

A função é esta: AvalMail ("bernardess@gmail.com")

Function AvalMail (ByVal EAddress As String) As Boolean

    ' Variáveis dimensionadas.

    Const AllowChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz._-"

    Dim UserName As String

    Dim ServerName As String

    Dim x As Long

    Dim i As Integer

    

    'Validate email address.

    Let x = InStr(1, EAddress, "@")

    

    If x = 0 Then GoTo BadAddress

    If InStr(x + 1, EAddress, "@") > 0 Then GoTo BadAddress

    

    Let UserName = Left$(EAddress, x - 1)

    Let ServerName = Right$(EAddress, Len(EAddress) - x)

    

    If Left$(UserName, 1) = "." Or Right$(UserName, 1) = "." Then GoTo BadAddress

    If Left$(ServerName, 1) = "." Or Right$(ServerName, 1) = "." Or InStr(1, ServerName, ".") = 0 Then GoTo BadAddress

    

    For i = 1 To Len(UserName)

        If InStr(1, AllowChars, Mid$(UserName, i, 1)) = 0 Then GoTo BadAddress

    Next

    

    For i = 1 To Len(ServerName)

        If InStr(1, AllowChars, Mid$(ServerName, i, 1)) = 0 Then GoTo BadAddress

    Next

    

    Let AvalMail = True

    Exit Function

BadAddress:

    Let AvalMail = False

End Function

References:

Tags: VBA, Tips, email, validade, avalia, checa, valida