[winopilot]

Hi, my first 'excel' post here. Been reading through related posts, and although I consider myself pretty adept at Excel, I have never messed with macros before this week, and am a bit lost. Here is my situation...

Working in a spreadsheet for orders. Each row is an item we carry. There are about 3000rows. Column P is the actual amount we decide to order, and after the person runs through the page typing in orders in column P (numeric field), he would hit a button and the items that have a value to order, would be compiled in a single email.

The columns needed in the email include A, B, C, P, Z, and AA. Although the spreadsheet will have 3000 rows, there will only be about 100 rows to order probably (if that matters). And it only needs to send those columns, ideally as a row, and all in the same email.

We are using Outlook 2007, and an SBS (if that matters), windows Vista.

Also, not sure if it matters, but most of the columns in the spreadsheet are filled in via "vlookups" on a different worksheet. Column P will be the only column actually typed in... but the "values" of the other columns need to be copied as opposed to formula or other...

I will also be trying to modify it to print the orders using a different button. but I'd be happy trying to figure out the email part first...

Any ideas? I am sure it can be done, drives me nuts to not be able to make the leap into VBA... but a deadline is looming and I am at my wits end.

thank you!

[Zack Barresse]

Hi there, and welcome to the board!

Sure we can do this. I'm assuming Excel 2007 as well as Outlook 2007? Do you want the email to send out automatically as well? If so you'll need either Outlook Redemption, ClickYes (freeware), or use CDO. All methods have been done on this board before and you could probably find with a good search. If you don't want it to send automatically we can just display the message and the user (you?) can click the send button manually. Some people still like to retain that bit of control, but we can do auto if you'd like.

Do you want the data populated in the body of the email as a range? We can handle the print at the same time if you'd like as well. Perhaps a message box asking to print after the email is generated?

Can you post your file? A word of warning, if you post a 'sample' file, you may get unexpected results. Please post your file - or as close to it structurally as you can. The more exact your data looks to us the better off you are. We get a lot of, "well now that you gave me a solution, this is what my data really looks like." Of course as you can imagine, it changes the solution totally sometimes. So please be as forthcoming as you can in regards to your data structure. If you can't post anything (we understand copyright and company policies) please describe in detail what you can. We would need to know header rows, where the data starts, rows the data is on or will be one, email recipients, questions above (i.e. send automatically or just display the message, data in body of message - i.e. format, etc), and how you want to fire this macro off. Also, should there be any sort of tracking of what you've emailed or to who?

[winopilot]

Zack,

Thanks for your reply. You raised some excellent points and ideas... I've tried to attach the actual file but it is too big to upload, and with multiple tabs I can't change it to TXT. I will run through your questions below and continue to work the upload....

1. yes, it is excel 2007 (we are almost cutting edge)... well, as it pertains to Microsoft, anyway.

2. I don't want the email to go automatically. Ideally, after the orders are put in (column P), he would hit the "send email" button and that 'positive confirmation' would give him a sense of closure.

3. I am not sure what you mean "email as a range?" Basically, It would be great if the values for each row would stay in a row format on the email so when the person who is getting this email prints it out, she could just run down a row at a time to enter the orders, if that makes sense.

4. As far as a nested print option... I'd rather just have the button. That way, if he doesn't want to email, but wants to print... he can do that. I think pushing buttons are the way to go on this project.

5. As far as tracking? Nah, don't need the ability to track the email... I assume it would reside in his "sent items" folder, and it is likely I would probably want to CC him, and a couple others, now that you mention that.

6. an additonal feature would be to include the total orders dollar amount (merged cell AD/AE6) at the bottom of the email so we have a tally of dollar amount also.

Anyway, I hope I answered the questions. I managed to reduce the file size quite drastically using the good ol' copy/paste. It doesnt have any of my formulas in there, vlookups, or other tabs that provide the updated information, but the data is there, and in the format it will be on release.

I appreciate your efforts!

-paul.

[Zack Barresse]

Thanks for the answers and spreadsheet sample.

What range exactly do you want mailed (row-wise, I understand the columns)? Is it just a specific range? Only certain ranges with values? I.e. just those values in column P which the user entered a value in? That's what I'm understanding.

Also your total orders dollar amount, what range there do you want at the bottom of the email? What we will probably do is copy the range to a new worksheet and just move it to the bottom of the range, so when we move the range to the body of the email it will all be there. You'll need to ensure there is no worksheet protection (or tell us if there is) and you can send with HTML in Outlook.

Formulas aren't a problem, we can copy them as values before they are included on the email. I just want to make sure about the above first.

[OBP]

Zack, another Access Application

[Zack Barresse]

LOL! Very well could be. But you know my drug of choice.

Okay, without answering any of my latest questions, this is the code as it stands, which will email the ranges you stated from Sheet1 only where there is a value greater than 0 (blanks will not count either) in column P, attach to the body of an email. Note the addresses and subject are hard-coded in there. Also it doesn't do anything with the totals yet.

Option Explicit

Sub CreateOutlookMail()

    Dim olApp As Object, olMail As Object, bOlCreated As Boolean
    Dim wb As Workbook, ws As Worksheet, wsTEMP As Worksheet
    Dim rCopy As Range, rSend As Range
    
    Call TOGGLEEVENTS(False)
    On Error Resume Next
    
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
        bOlCreated = True
        Err.Clear
    Else
        bOlCreated = False
    End If
    Set olMail = olApp.CreateItem(0)
    
    '----######################-------------------
    '----## Set To/Cc/Bcc here ##-----------------
    olMail.To = "to@someone.com"
    olMail.Cc = "cc@someone.com; cc2@someone.com"
    olMail.Bcc = "bcc@someone.com; bcc2@someone.com; bcc3@someone.com"
    '----## Set Subject here ##-------------------
    olMail.Subject = "ENTER YOUR SUBJECT HERE"
    '----######################-------------------
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1") '## CHANGE IF IT IS NOT ALWAYS THIS WORKSHEET!
    Set wsTEMP = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
    
    ws.Range("A:AA").AutoFilter Field:=16, Criteria1:=">0"
    Set rCopy = ws.Range("A:AA").SpecialCells(xlCellTypeVisible)
    rCopy.Copy wsTEMP.Range("A1")
    wsTEMP.Range("A:AA").Value = wsTEMP.Range("A:AA").Value
    wsTEMP.Range("D:O,Q:Y").Delete
    Set rSend = wsTEMP.Range("A1:F" & wsTEMP.Cells(ws.Rows.Count, 1).End(xlUp).Row)
    
    Call DeleteAllShapes(wsTEMP)
    ws.AutoFilterMode = False
    
    olMail.HTMLBody = RangetoHTML(rSend)
    olMail.Display
    wsTEMP.Delete
    
    If bOlCreated = True Then olApp.Quit
    Call TOGGLEEVENTS(True)
    
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Sub TOGGLEEVENTS(blnState As Boolean)
'Originally written by Zack Barresse
    Application.DisplayAlerts = blnState
    Application.EnableEvents = blnState
    Application.ScreenUpdating = blnState
    If blnState Then Application.CutCopyMode = False
    If blnState Then Application.StatusBar = False
End Sub

Sub DeleteAllShapes(wks As Worksheet)
'Originally from Ron de Bruin
    On Error Resume Next
    wks.DrawingObjects.Visible = True
    wks.DrawingObjects.Delete
    On Error GoTo 0
End Sub

[winopilot]

Zack,

thanks for the reply(ies)...

To answer those questions, I just want emailed the rows that have a value in column P...

And for the total to email, it would be the total that shows in merged cell AD/AE6. That value is calculated (via formula) of a total cost of the orders as column P is populated, so the only thing that needed to be included is that cell value. if that makes sense.

As it stands, there is no worksheet protection, but I am seriously considering adding some (for all cells except columnP) so there is no chance of a mis-type.

HTML in outlook not a problem at all.

If you are talking about moving the range to a new worksheet, that is a just fine, and would work brilliantly.

Hope I covered what you asked. I will take a look at the code, but wanted to answer your questions.

-paul.

[winopilot]

Okay, so an update: I added the code, ran it, and it generate a an email, but doesnt insert anything. It also moves to the last sheet in the qworkbook, but doesn't add anything there. I suspect maybe I am doing something wrong, but that's what is happeneing right now.

[winopilot]

Okay, an update... in the body of the email is a blank cell. But that is all. No text.

[Zack Barresse]

I'll take a look at it. Word shouldn't be your email editor in Outlook to run this code, btw.

[Zack Barresse]

Couple of lines changed. Original (active) sheet should be selected when routine is done, total cell is put two rows below the last cell of data to email...

Option Explicit

Sub CreateOutlookMail()

    Dim olApp As Object, olMail As Object, bOlCreated As Boolean
    Dim wb As Workbook, ws As Worksheet, wsTEMP As Worksheet
    Dim rCopy As Range, rSend As Range, wsActive As Worksheet
    
    Call TOGGLEEVENTS(False)
    On Error Resume Next
    
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
        bOlCreated = True
        Err.Clear
    Else
        bOlCreated = False
    End If
    Set olMail = olApp.CreateItem(0)
    
    '----######################-------------------
    '----## Set To/Cc/Bcc here ##-----------------
    olMail.To = "to@someone.com"
    olMail.Cc = "cc@someone.com; cc2@someone.com"
    olMail.Bcc = "bcc@someone.com; bcc2@someone.com; bcc3@someone.com"
    '----## Set Subject here ##-------------------
    olMail.Subject = "ENTER YOUR SUBJECT HERE"
    '----######################-------------------
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1") '## CHANGE IF IT IS NOT ALWAYS THIS WORKSHEET!
    Set wsActive = wb.ActiveSheet
    Set wsTEMP = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
    
    ws.Range("A:AA").AutoFilter Field:=16, Criteria1:=">0"
    Set rCopy = ws.Range("A:AA").SpecialCells(xlCellTypeVisible)
    rCopy.Copy wsTEMP.Range("A1")
    wsTEMP.Range("A:AA").Value = wsTEMP.Range("A:AA").Value
    wsTEMP.Range("D:O,Q:Y").Delete
    ws.Range("AD6").Copy wsTEMP.Cells(ws.Rows.Count, 1).End(xlUp).Offset(2, 0)
    wsTEMP.Cells(ws.Rows.Count, 1).End(xlUp).Value = ws.Range("AD6").Value
    Set rSend = wsTEMP.Range("A1:F" & wsTEMP.Cells(ws.Rows.Count, 1).End(xlUp).Row)
    
    Call DeleteAllShapes(wsTEMP)
    ws.AutoFilterMode = False
    
    olMail.HTMLBody = RangetoHTML(rSend)
    olMail.Display
    wsTEMP.Delete
    wsActive.Activate
    
    If bOlCreated = True Then olApp.Quit
    Call TOGGLEEVENTS(True)
    
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Sub TOGGLEEVENTS(blnState As Boolean)
'Originally written by Zack Barresse
    Application.DisplayAlerts = blnState
    Application.EnableEvents = blnState
    Application.ScreenUpdating = blnState
    If blnState Then Application.CutCopyMode = False
    If blnState Then Application.StatusBar = False
End Sub

Sub DeleteAllShapes(wks As Worksheet)
'Originally from Ron de Bruin
    On Error Resume Next
    wks.DrawingObjects.Visible = True
    wks.DrawingObjects.Delete
    On Error GoTo 0
End Sub

[slurpee55]

Zack, didn't MS change Outlook in 2007 so Word is the default HTML handler? I think they did, because of the security issues they had had with IE being the handler. Of course, now that IE8 is out, it seems a totally wrong path to have taken, but, well, that's MS.

[Zack Barresse]

I wasn't aware of that change. Good to know! The RangetoHTML() function came from Ron de Bruin, and he recommended not to use Word as the HTML editor - but it was for adding HTML to the body manually (via code) along with his routine. Not sure what we're looking at yet as far as problems go. It works a treat for me. We'll have to wait and hear some more details from the poster I think.

[slurpee55]

I have dealt with other problems based on using Word for HTML - as a (very) old HTML coder, I find the HTML Word generates disgusting - full of unnecessary lines of code, and a lot of non-standard code as well.
Probably will do well enough for an email, but it sure is poor for web pages.

(For instance, using 2003, I took the above, pasted it into Word and saved it as HTML. I then did the same in Notepad. The Word version? 129 lines. The Notepad version? 14 lines. And the Notepad version displayed correctly; the Word version lost blank lines.)

[winopilot]

Okay, sorry for my delay... I got sidetracked and just now able to jump back in this. Crazy time of the year for us.

I appreciate the updated code... I will run it and see how it looks. fingers crossed!