PDA

View Full Version : [SOLVED] fun work in progress...



Blakieto
07-08-2004, 05:26 PM
Hey All,

I've been working on auto-generated emails, containing data from Excel cells. This is what I have so far (a few hours of work.) I'm surprised that something like this is not built in... maybe it is and I've simply missed it?

Passed a text string (a cell containing text) this routine will replace every occurance of "=CELL(row,column)" with the contents of that Excel cell. For example, if cell(1,1) were to contain the word "Betty", then the string "Hi =CELL(1,1) How are you?" becomes "Hi Betty How are you?".


Public Function MsgSubstituteCellRefs(Msg As String) As String
' Given a string that contains items like "=CELL(1,3)", each occurance of such "cell references"
' are replaced with the contents of that Excel cell. Great for use with GenerateEmail()
Dim length As Integer
Dim i As Integer ' current location within Msg we're parsing
Dim j As Integer ' current location within cell reference we're parsing
Dim k As Integer ' scratch
Dim ci As Variant ' cell reference indexes
Dim crr As Integer ' cell reference row
Dim crc As Integer ' cell reference column
Dim cw As Integer ' current word start
Dim word As String ' current word being parsed
Dim final As String ' final msg with cell references replaced with cell values
' first get rid of any extra spaces:
Msg = Application.Trim(Msg)
length = Len(Msg)
cw = 1
For i = 1 To length
If (Mid(Msg, i, 1) = " ") Then
' we've found a word break:
If (Mid(Msg, cw, 6) = "=CELL(") Then
' we've found a cell reference:
cw = cw + 6 ' position cw just after the open bracket
For j = cw To length
If (Mid(Msg, j, 1) = ")") Then
' we've located the ending bracket
' between cw and j is our cell reference
word = Mid(Msg, cw, j - cw)
ci = Split(word, ",")
k = UBound(ci)
If (k <> 1) Then
word = "BAD_CELL_REFERENCE"
Else
crr = ci(0) ' get cell reference row
crc = ci(1) ' get cell reference column
word = Cells(crr, crc) ' resolve cell reference
End If
final = final & word & " " ' add the cell reference to the final msg
cw = j + 1
i = cw
Exit For
End If
Next j
Else
word = Mid(Msg, cw, i - cw)
final = final & word & " "
cw = i + 1
End If
End If
Next i
' pick up the last portion of the message:
If (cw <> 1) Then
final = final & Mid(Msg, cw, length)
final = Application.Trim(final)
End If
MsgSubstituteCellRefs = final
End Function


Then the above can be used with this to generate whatever email one may like:



Public Function GenerateEmail(Subject As String, Msg As String, _
Recipient As String, Addr As String, _
Optional CC As String = "", _
Optional CCAddr As String = "") As String
Dim mapi_session As MAPI.Session
Dim mapi_message As MAPI.Message
Dim mapi_recipient As MAPI.Recipient
On Error GoTo SendMailError
' Create the MAPI session.
Set mapi_session = CreateObject("MAPI.Session")
mapi_session.Logon ProfileName:="Outlook"
' Create a message.
Set mapi_message = mapi_session.Outbox.Messages.Add
mapi_message.Subject = Subject
mapi_message.Text = Msg
' Add a recipient.
Set mapi_recipient = mapi_message.Recipients.Add
mapi_recipient.Name = Recipient
mapi_recipient.Type = CdoTo
mapi_recipient.Address = "SMTP:" & Addr
' mapi_recipient.Resolve
' only process the CC logic if both the CC name and addr is present:
If ((Not IsMissing(CC)) And (Not IsMissing(CCAddr))) Then
' Add a CC entry.
Set mapi_recipient = mapi_message.Recipients.Add
mapi_recipient.Name = CC
mapi_recipient.Type = CdoCc
mapi_recipient.Address = "SMTP:" & CCAddr
' mapi_recipient.Resolve
End If
' Send the message.
mapi_message.Send ShowDialog:=False
mapi_session.Logoff
GenerateEmail = "Success"
Exit Function
SendMailError:
MsgBox "Error " & Format$(Err.Number) & " sending mail" & _
vbCrLf & Err.Description, vbExclamation, "Error"
mapi_session.Logoff
GenerateEmail = Err.Description
Exit Function
End Function


The only tricky part is that the user needs to have Outlook running or it seems to error... Plus, I want to add some formatting capabilities to MsgSubstituteCellRefs() too.

Am I redoing capabilities that are already present?

-Blakieto

Jacob Hilderbrand
07-08-2004, 06:01 PM
Makes me think of a mail merge. But this looks good for emailing. Keep working on it and when it is done post it to the kb. Did you have any specific questions you needed help on?

Anne Troy
07-08-2004, 07:19 PM
Check out how we handle Outlook in this kb entry; maybe that'll help?
http://www.vbaexpress.com/kb/getarticle.php?kb_id=97

Anne Troy
07-08-2004, 07:21 PM
Also see my signature to learn how to use our way cool VBA tags. :)

Ivan F Moala
07-09-2004, 03:55 AM
your need to make sure Outlook is ready

Try something along these lines



'// Create an instance of Outlook (or use existing instance if it already exists)
On Error Resume Next
Set objOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set objOutlookApp = CreateObject("Outlook.Application")
'// We need the Application Open in order to NOT show as attachment
Shell objOutlookApp, vbMaximizedFocus
End If
On Error GoTo 0



Also, not to take away from what you have done but there are other methods to post a sheets contents (selected or not) via html and CDO

eg. I have a Method to insert an Image/screen shot of a User selected range from within Excel and paste to an Email msg.

Also DK's code here

http://www.danielklann.com/excel/sending_a_range_as_the_body.htm

hamster_0102
09-18-2005, 03:57 PM
Check out how we handle Outlook in this kb entry; maybe that'll help?
http://www.vbaexpress.com/kb/getarticle.php?kb_id=97

This is most helpful to me. Lucky, I found this forum.

Question: On the body of the message, I want to make a line bold to highlight this sentence from the rest of the message. Is this doable?