Solved

Emailing from button on spreadsheet

Posted on 2013-02-07
32
194 Views
Last Modified: 2013-02-20
Hi

I have a spreadsheet attached that has toner quantities on it, with help from ssaqibh ive added some buttons to update qtys but would like to add a button that sends a toner order email.

Basically the code needs to pick up all toners from column L:L that have a positive number in and add the line to an email.  Only the data from B:B and D:D would be needed along with Qty to order.

Email would look like this

------------------------------------
Hi, can you order the following toners please, Thank you.

C9730A             HP Colour LJ 5550 Black Toner      x      1
C9732A             HP Colour LJ 5550 Yellow Toner      x      1
-----------------------------------


I know how to setup the button so just need the code to create email


Cheers
G
Daily---Weekly-Toner-Audit-and-O.xlsm
0
Comment
Question by:GRiTech
  • 19
  • 13
32 Comments
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38864109
Change the email in this and give it a try. The HP Colour LJ M4345 Maintenance Kit - 220V order line is behaving badly. I'll work on it some more. Note: Use .Send to send it directly rather than .Display


Sub CreateEmail()

Dim OutApp As Object
Dim OutMail As Object
Dim lngLastRow As Long
Dim lngRow As Long
Dim strBody As String
    
    lngLastRow = Range("B65536").End(xlUp).Row
    Set OutApp = CreateObject("Outlook.Application")

    strBody = "Hi, can you order the following toners please, Thank you." & vbCrLf & vbCrLf
    
    Set OutMail = OutApp.CreateItem(0)

        On Error Resume Next
        With OutMail
            .To = "youremail address"
            .cc = ""
            .BCC = ""
            .Subject = "Toner Order"
            For lngRow = 2 To lngLastRow
                If Cells(lngRow, 12).Value > 0 Then
                    strBody = strBody & Cells(lngRow, 2).Value _
                            & vbTab & Cells(lngRow, 4).Value _
                            & Space(50 - Len(Cells(lngRow, 4).Value)) & vbTab & vbTab & "x" _
                            & vbTab & Cells(lngRow, 12).Value & vbCrLf
                End If
            Next
            .body = strBody
            .Display '.Send     'or use .Display  '<------- USE ONE OR THE OTHER...NOT BOTH
        End With
        On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38864253
Okay this is better


Sub CreateEmail()

Dim OutApp As Object
Dim OutMail As Object
Dim lngLastRow As Long
Dim lngRow As Long
Dim strBody As String
Dim strTemp As String * 50

    lngLastRow = Range("B65536").End(xlUp).Row
    Set OutApp = CreateObject("Outlook.Application")

    strBody = "Hi, can you order the following toners please, Thank you." & vbCrLf & vbCrLf
    
    Set OutMail = OutApp.CreateItem(0)

        On Error Resume Next
        With OutMail
            .To = "martinhliss@.com"
            .cc = ""
            .BCC = ""
            .Subject = "Toner Order"
            For lngRow = 2 To lngLastRow
                If Cells(lngRow, 12).Value > 0 Then
                    strTemp = Cells(lngRow, 4).Value
                    If Len(Cells(lngRow, 4).Value) < 40 Then
                        strBody = strBody & Cells(lngRow, 2).Value _
                                & vbTab & strTemp _
                                & vbTab & vbTab & "x" _
                                & vbTab & Cells(lngRow, 12).Value & vbCrLf
                    Else
                        strBody = strBody & Cells(lngRow, 2).Value _
                                & vbTab & strTemp _
                                & vbTab & "x" _
                                & vbTab & Cells(lngRow, 12).Value & vbCrLf
                    End If
                End If
            Next
            .body = strBody
            .Display '.Send     'or use .Display  '<------- USE ONE OR THE OTHER...NOT BOTH
        End With
        On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Open in new window

0
 
LVL 1

Author Comment

by:GRiTech
ID: 38864792
Thats excellent thank you

Just to be picky is there a way of lining up the  totals in a neat column rather than staggered?

Ive looked at the code but cat figure out how to do it

ie

C9730A        HP Colour LJ 5550 Black Toner        x      1
C9732A        HP Colour LJ 5550 Yellow Toner      x      1


Cheers
G
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38864864
Well in order to do that there are two possibilities that I can think of:

1) Figure out how to get Outlook to use an (ugly) fixed font like Courier, or
2) Attach a temporary worksheet that contains the details of the order.

I've done the latter previously so that would be the easiest for me.
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38864930
If its not to much trouble attaching a temp worksheet would look neatest.  But if that is difficult dont worry about it I'll run with what I have.

Cheers
G
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38866006
Having some problems but I'm working on it.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38866041
Okay that last post was unnecessary:)

Here's an updated workbook. It contains a hidden sheet called 'New Order' and a macro called CreateEmail in Module1.
Toner-Audit.xlsm
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38867476
OK possibly stupid questions,

how can I see the hidden sheet?

Does the code create the hidden sheet?

Can I copy the code into my master spreadsheet?
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38868190
how can I see the hidden sheet?
Look in the 'CreateEmail' macro and you'll see this code which after defining shtNewOrder as a Worksheet and Set-ing it to the sheet, unhides and hides the sheet.
        ' The New Order sheet is hidden but it must be visible (at least temporarily)
        ' in order to copy it
    With shtNewOrder
            .Visible = xlSheetVisible
            ' This creates a new workbook...
            .Copy
            Set wbDest = ActiveWorkbook
            .Visible = xlSheetHidden
        End With
    End With

Open in new window


Does the code create the hidden sheet?
Initially after creating the sheet I just right-clicked on the sheet's tab and selected "Hide".

Can I copy the code into my master spreadsheet?
Sure, the CreateEmail macro is self-contained.
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38880208
Brilliant that works

Sorry to be a pain but how easy would it be to past the relavant cells of spreadsheet into the email rather than as attachment.

Thanks for your help

G
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38880234
I'll take a look at at.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38880492
This uses more great code from Ron deBruin (the new RangetoHTML function).


Sub CreateEmail()
'From http://www.rondebruin.nl/mail/folder2/mail2.htm

'Working in 2000-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim wbTonerAudit As Workbook
Dim shtNewOrder As Worksheet
Dim shtSource As Worksheet
'Dim wbDest As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim lngNewRow As Long
Dim rng As Range
Dim strBody As String

    Set wbTonerAudit = ActiveWorkbook
'    TempFilePath = Environ$("temp") & "\"
    Set OutApp = CreateObject("Outlook.Application")

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set shtNewOrder = ActiveWorkbook.Sheets("New Order")
    Set shtSource = ActiveWorkbook.Sheets("Toner Audit")
  
    lngLastRow = shtSource.Range("B65536").End(xlUp).Row
    ' Clear any old order data
    shtNewOrder.UsedRange.Cells.Offset(1, 0).ClearContents

    With shtSource
'        ' Fill New Order with the order data
        lngNewRow = 1
        For lngRow = 2 To lngLastRow
            If .Cells(lngRow, 12).Value > 0 Then
                lngNewRow = lngNewRow + 1
                shtNewOrder.Cells(lngNewRow, 1).Value = .Cells(lngRow, 2).Value
                shtNewOrder.Cells(lngNewRow, 2).Value = .Cells(lngRow, 4).Value
                shtNewOrder.Cells(lngNewRow, 3).Value = .Cells(lngRow, 12).Value
            End If
        Next
        Set rng = shtNewOrder.Range("A1:C" & lngNewRow).SpecialCells(xlCellTypeVisible)
    End With
    
    ' Create the email
    strBody = "Please order these items." & "<br><br>"
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "Your email address@.com"
        .cc = ""
        .BCC = ""
        .Subject = "Toner Order"
        .Body = "Please order these items."
        .HTMLBody = strBody & RangetoHTML(rng)
        .Display '.Send     'or use .Display  '<------- USE ONE OR THE OTHER...NOT BOTH
    End With
    
    With shtNewOrder
        .UsedRange.Cells.Offset(1, 0).ClearContents
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    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

Open in new window

0
 
LVL 1

Author Comment

by:GRiTech
ID: 38880549
Error says

Compile error: inside out procedure

Debugger highlights Set at this part of code

Set wbTonerAudit = ActiveWorkbook
'    TempFilePath = Environ$("temp") & "\"
    Set OutApp = CreateObject("Outlook.Application")
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38880577
Here's the workbook I used which works. Run the CreateEmail macro.
Toner-Audit.xlsm
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38880824
Ok Cancel that ... I didnt change the email address

Thats what I need and will save me loads of time thanks ...

 the only tweak I need now is at present its only pasting

HP Colour

rather than

HP Colour LJ 5550 Black Toner

Ive checked the code but cant figure which bit to change to get the full text


Cheers
G
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38880846
????
...
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 45

Expert Comment

by:Martin Liss
ID: 38880850
Attach your workbook if you need to.
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38881341
I get this
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38881375
Have attached workbook  Code in Module 6
Daily---Weekly-Toner-Audit-and-O.xlsm
0
 
LVL 45

Accepted Solution

by:
Martin Liss earned 500 total points
ID: 38881757
Here's a modified version of CreateEmail. Believe it or not the problem was happening because column B on the hidden sheet wasn't wide enough to show the full description even though it was there. The correction is at lines 40 to 42. I also removed some unneeded variables.

Sub CreateEmail()
'From http://www.rondebruin.nl/mail/folder2/mail2.htm

'Working in 2000-2010
Dim wbTonerAudit As Workbook
Dim shtNewOrder As Worksheet
Dim shtSource As Worksheet
Dim OutApp As Object
Dim OutMail As Object
Dim lngNewRow As Long
Dim rng As Range
Dim strBody As String

    Set wbTonerAudit = ActiveWorkbook
    Set OutApp = CreateObject("Outlook.Application")

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set shtNewOrder = ActiveWorkbook.Sheets("New Order")
    Set shtSource = ActiveWorkbook.Sheets("Toner Audit")
  
    lngLastRow = shtSource.Range("B65536").End(xlUp).Row
    ' Clear any old order data
    shtNewOrder.UsedRange.Cells.Offset(1, 0).ClearContents

    With shtSource
        ' Fill New Order with the order data
        lngNewRow = 1
        For lngRow = 2 To lngLastRow
            If .Cells(lngRow, 12).Value > 0 Then
                lngNewRow = lngNewRow + 1
                shtNewOrder.Cells(lngNewRow, 1).Value = .Cells(lngRow, 2).Value
                shtNewOrder.Cells(lngNewRow, 2).Value = .Cells(lngRow, 4).Value
                shtNewOrder.Cells(lngNewRow, 3).Value = .Cells(lngRow, 12).Value
            End If
        Next
        Columns("A:A").EntireColumn.AutoFit
        Columns("B:B").EntireColumn.AutoFit
        Columns("C:C").EntireColumn.AutoFit
        Set rng = shtNewOrder.Range("A1:C" & lngNewRow).SpecialCells(xlCellTypeVisible)
    End With
    
    ' Create the email
    strBody = "Please order these items." & "<br><br>"
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "CL_Procurement@O2.COM"
        .cc = ""
        .BCC = ""
        .Subject = "Toner Order"
        .Body = "Hi Procurement, can you order the following toners please, Thank you."
        .HTMLBody = strBody & RangetoHTML(rng)
        .Display '.Send     'or use .Display  '<------- USE ONE OR THE OTHER...NOT BOTH
    End With
    
    With shtNewOrder
        .UsedRange.Cells.Offset(1, 0).ClearContents
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38881774
Also, change line 61 to

.UsedRange.Cells.ClearContents
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38883678
Hmmm did that, still getting same output on email.

I noticed that lines 40-42 dont seem to match the columns on spreadsheet. In an attempt to have a go myself (As I realise Im taking up a lot of your time) I changed the lines to match column data.

Like so

Next
        'Columns("A:A").EntireColumn.AutoFit
        'Columns("B:B").EntireColumn.AutoFit
        'Columns("C:C").EntireColumn.AutoFit
        Columns("B:B").EntireColumn.AutoFit
        Columns("D:D").EntireColumn.AutoFit
        Columns("L:L").EntireColumn.AutoFit

But it made no difference, so I've obviously got it wrong :-)

also doesn't pick up my text at line 55 and puts the text at 47 in instead

Cheers
G

Yeah changing text at line 47 puts the correct text in. Whats line 55 for?
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38884654
Lines 40 through 42 refer to the columns on the hidden output sheet named "New Order" and not the source sheet which is the sheet named "Toner Audit". The output sheet has only 3 columns which are of course "A", "B" and "C". If you want to see the sheet, go to the Immediate window and type worksheets("New Order").Visible = xlSheetVisible and press return which will expose the tab for the sheet.

The .body line (line 55) is a mistake on my part. .body is used to write to "plain text' email and when it is followed by  the .HTMLbody line it is ignored, so remove line 55 and change line 47 to the following.

 strBody = "Hi Procurement, can you order the following toners please, Thank you." & "<br><br>"
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38884974
OK thanks done that

 Im still not getting the full text tho,  it cuts of at HP Colour


Hi Procurement, can you order the following toners please, Thank you.
   
C9730A      HP Colour         2
C9732A      HP Colour         1
C9733A      HP Colour         1
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38885001
Did you use the code from post ID: 38881757 exactly like I posted it?
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38885072
Yes code from post ID: 38881757 exactly like as posted

Except for removing line 55 and changing line 47 to

 strBody = "Hi Procurement, can you order the following toners please, Thank you." & "<br><br>"


Have a work around though If I set column B to 35.00 width on hidden sheet it all works
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38885087
Whatever works:)
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38885394
So, are we done here?
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38907595
Since you haven't awarded points yet I assume that there's still some problem. How can I help?
0
 
LVL 1

Author Comment

by:GRiTech
ID: 38909522
Sorry I was off for a bit
0
 
LVL 1

Author Closing Comment

by:GRiTech
ID: 38909530
Excellent support and solution thanks very much for your help
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38910186
You're welcome and I'm glad I was able to help.

Marty - MVP 2009 to 2012
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now