fun work in progress...

[Blakieto]

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]

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]

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]

Also see my signature to learn how to use our way cool VBA tags.

[Ivan F Moala]

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/sen...s_the_body.htm

[hamster_0102]

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?