Take the 2-minute tour ×
Super User is a question and answer site for computer enthusiasts and power users. It's 100% free, no registration required.

I am attempting to find an Excel macro that would get the headers from a table, and then copy certain rows into an email.

For example

State  |  Store  |  Points
Store1 |  VIC    |  3201
Store2 |  NSW    |  1234
Store3 |  QLD    |  4234

I have this following code, that allows me to select the whole table, and it copies into the email and sends it, though i need it automated to extract the single rows

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

Sub Mail_Selection_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
     "\Microsoft\Signatures\Default.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "email@address"
        .CC = ""
        .BCC = ""
        .Subject = "My Subject here"
        .HTMLBody = "<i></i> Hi<br/>" & _
        "Please find below a summary of activity.<br/><h3>National Summary</h3>" & _
        RangetoHTML(rng) & Signature
        .Send   'or use .Display
    End With
    On Error GoTo 0

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

    Set OutMail = Nothing
    Set OutApp = Nothing
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

What I need is for the code to copy rows of a specific Store to the email so only that Store's information is in the message. How can I do this for each unique value in State column?

share|improve this question
add comment

1 Answer

up vote 0 down vote accepted

You are creating the HTML file from the sheet's UsedRange.

'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

After you set Sheet:=TempWB.Sheets(1).Name you could instead declare another range variable to capture ONLY the row(s) needed for each store, and then use that as the Source:=.

Your code is not working on my Excel 2010 so I'm not able to verify unfortunately, but instead of using the usedRange you should be able to just specify a range address in another variable.

Example:

Sub PublishObjectFromFilteredRange()
'An example of applying autofilter to sheet
' and setting range variable = to the autofiltered cells/visible cells
Dim ws As Worksheet
Dim storeID As String
Dim tableRange As Range
Dim filteredRange As Range
Dim pObj As PublishObject
Set ws = Sheets("Sheet1")

'Define the range of the table
Set tableRange = ws.Range(Range("A1").End(xlDown), Range("A1").End(xlToRight))

'Define the Store for which you want to create the report
storeID = "Store 1" '<---- change this as necessary

'Set a filter on the table
tableRange.AutoFilter Field:=1, Criteria1:=storeID

'determine the visible table range
Set filteredRange = tableRange.Cells.SpecialCells(xlCellTypeVisible)

'Create & publish the PublishObject
Set pObj = ActiveWorkbook.PublishObjects.Add( _
    SourceType:=xlSourceRange, _
    Filename:="C:\Users\david_zemens\Desktop\publish.htm", _
    sheet:="Sheet1", _
    Source:=filteredRange.Address, _
    HtmlType:=xlHtmlStatic)

    pObj.Publish True


End Sub
share|improve this answer
    
Hi David, more or less i need only the header ie State, Store, Points then Store3 only to see the information relating to store 3 does that make sense? –  user199371 Feb 18 '13 at 0:13
    
Yes, makes perfect sense> I just couldn't get your code to work but I have fixed it now. I have revised my answer with a sample of code that uses the AutoFilter. You should be able to modify this to include a loop over the names in column 1, if desired. –  David Zemens Feb 18 '13 at 1:48
    
Thanks David I have the code finding the store, and producing the html, how do I get it to feed back to my email. atm im doing this by On Error Resume Next With OutMail .To = "address@email" .CC = "" .BCC = "" .Subject = "Monthly Activity Report" .HTMLBody = "<i></i> Hi<br/>" & _ "Please find below a summary of activity.<br/><h3>National Summary</h3>" & _ PublishObjectFromFilteredRange() & Signature .Send 'or use .Display End With On Error GoTo 0 –  user199371 Feb 18 '13 at 5:18
    
Please consider marking my answer as "accepted" and posting your new question as a NEW question. I would start by trying to play with the code here: visualbasic.ittoolbox.com/groups/technical-functional/vb-vba-l/… –  David Zemens Feb 18 '13 at 12:11
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.