PDA

View Full Version : Email and Font and color issue



Canuckbulldo
10-19-2007, 04:44 PM
My problem is probably very simple?

I've been tasked with creating a bunch of macros in Excel to facilitate use of a massive spreadsheet.

Issues I currently have!

1. Have created a macro to submit an automated email pulling data from the excel sheet. It works fine, how do I change the Send From info in Outlook. We each have 2 mail accounts, personal and corporate (Shared)
When using this macro I want the VBA code to change the sender to the corporate address so that customers will reply to that one and not the personal address.

2. How do you in the code, change the fonts!

Thank You

Here's the code I have so far!

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub Accus?Reception()
Dim ClientName As String
Dim CCName As String
Dim ConfNumber As String
Dim Subj As String
Dim Msg As String
Dim URL As String


' Get the value of the cells for the email information
ClientName = ActiveCell
CCName = ActiveCell.Offset(0, 1)
ConfNumber = ActiveCell.Offset(0, 2)


' Message subject
Subj = "Votre accus? de reception / Your acknowledgement of order"

' Compose the message
Msg = ""

' Texte (Francais)
' Mise en garde de r?ponce
Msg = Msg & "Ceci est un message automatiser, S.V.P. ne pas repondre." & vbCrLf & vbCrLf
' Salutation
Msg = Msg & "Cher client, " & ClientName & "," & vbCrLf & vbCrLf
Msg = Msg & "Bonjour," & vbCrLf
' Corps Principale
Msg = Msg & "Je vous envoi ce couriel pour vous confirm? que votre ou vos document(s)" & vbCrLf
Msg = Msg & "on ?t? exp?dier a notre d?partement de la traduction." & vbCrLf
Msg = Msg & "Votre num?ro de confirmation est : " & ConfNumber & "." & vbCrLf & vbCrLf
' Fermeture
Msg = Msg & "Merci!" & vbCrLf & vbCrLf


' Texte (Anglais)
' Mise en garde de r?ponce
Msg = Msg & "This is an automated message, Please do not respond." & vbCrLf & vbCrLf
' Salutation
Msg = Msg & "Dear Customer, " & ClientName & "," & vbCrLf & vbCrLf
Msg = Msg & "Good day," & vbCrLf
' Corps Principale
Msg = Msg & "I send to you the confirmation that your document(s)" & vbCrLf
Msg = Msg & "as been forwarded to our translation department." & vbCrLf
Msg = Msg & "Your reference number is : " & ConfNumber & "." & vbCrLf & vbCrLf
' Fermeture
Msg = Msg & "Thank You!" & vbCrLf & vbCrLf


' Signature


' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")


' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

' Create the URL
URL = "mailto: ("")" & ClientName & "?subject=" & Subj & "&body=" & Msg & "&Cc=" & CCName


' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"

End Sub