Consulting

Results 1 to 13 of 13

Thread: Solved: Copy EXCEL Cell To E-Mail Subject

  1. #1

    Solved: Copy EXCEL Cell To E-Mail Subject

    Hi,

    I am trying to copy a cell from an excel file I attached and paste it into the subject of the e-mail.

    For example, right now the macro below makes the subject "Date - ", where I want it to be "Date - 10/08/2008". Where 10/08/2008 comes from the attached file: "C:\File.xls", sheet "Sheet1", cell A1.

    How do I do this?

    This is the code I have so far.

    Thanks.

    I am using Excel / Outlook 2003.

    [vba]
    Sub Send_File()
    Dim msg As Outlook.MailItem
    Set msg = Application.CreateItem(olMailItem)
    msg.Subject = "Date - "
    msg.To = JoeSchmoe@aol.com
    msg.CC = JaneDoe@gmail.com
    msg.Body = "This is the message body."
    msg.Attachments.Add "C:\File.xls"
    msg.Display
    End Sub
    [/vba]

  2. #2
    VBAX Expert
    Joined
    Aug 2004
    Posts
    751
    Location
    This will read cell A1 for that date that you are after.
    [vba]
    ' Need to Reference Microsoft ActiveX Data Object 2.x
    Private Function GetExcelConnection(ByVal Path As String, _
    Optional ByVal Headers As Boolean = True) As Connection
    Dim strConn As String
    Dim objConn As ADODB.Connection
    Set objConn = New ADODB.Connection
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Path & ";" & _
    "Extended Properties=""Excel 8.0;HDR=" & _
    IIf(Headers, "Yes", "No") & """"
    objConn.Open strConn
    Set GetExcelConnection = objConn
    End Function
    Sub test()
    Dim objRS As ADODB.Recordset
    Dim strConn As String
    Dim objConn As ADODB.Connection
    Dim SubjectDate As Date
    'To read a sheet:
    ' strRequest = "SELECT * FROM Sheet1$"

    'To refer to a range by its address:
    ' strRequest = "SELECT * FROM [Sheet1$A110]"
    'To refer to a single-cell range, pretend it's a multi-cell range
    'and specify both the top-left and bottom-right cells:
    strRequest = "SELECT * FROM [Sheet1$A1:A1]"

    'To read a named range:
    ' strRequest = "SELECT * FROM MyDataRange"

    'To read a worksheet-level named range
    ' strRequest = "SELECT * FROM [Sheet1$MyData]"
    Set objConn = GetExcelConnection("c:\test.xls", False)
    'and then just open a recordset
    Set objRS = objConn.Execute(strRequest)
    objRS.MoveFirst
    Do While Not objRS.EOF
    SubjectDate = objRS.Fields(0).Value
    MsgBox SubjectDate
    objRS.MoveNext
    Loop
    Set objRS = Nothing
    Set objConn = Nothing
    End Sub
    [/vba]


    [vba]
    msg.Subject = "Date - " & SubjectDate
    [/vba]

  3. #3
    Quote Originally Posted by JKwan
    This will read cell A1 for that date that you are after.
    [vba]
    ' Need to Reference Microsoft ActiveX Data Object 2.x
    Private Function GetExcelConnection(ByVal Path As String, _
    Optional ByVal Headers As Boolean = True) As Connection
    Dim strConn As String
    Dim objConn As ADODB.Connection
    Set objConn = New ADODB.Connection
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Path & ";" & _
    "Extended Properties=""Excel 8.0;HDR=" & _
    IIf(Headers, "Yes", "No") & """"
    objConn.Open strConn
    Set GetExcelConnection = objConn
    End Function
    Sub test()
    Dim objRS As ADODB.Recordset
    Dim strConn As String
    Dim objConn As ADODB.Connection
    Dim SubjectDate As Date
    'To read a sheet:
    ' strRequest = "SELECT * FROM Sheet1$"

    'To refer to a range by its address:
    ' strRequest = "SELECT * FROM [Sheet1$A110]"
    'To refer to a single-cell range, pretend it's a multi-cell range
    'and specify both the top-left and bottom-right cells:
    strRequest = "SELECT * FROM [Sheet1$A1:A1]"

    'To read a named range:
    ' strRequest = "SELECT * FROM MyDataRange"

    'To read a worksheet-level named range
    ' strRequest = "SELECT * FROM [Sheet1$MyData]"
    Set objConn = GetExcelConnection("c:\test.xls", False)
    'and then just open a recordset
    Set objRS = objConn.Execute(strRequest)
    objRS.MoveFirst
    Do While Not objRS.EOF
    SubjectDate = objRS.Fields(0).Value
    MsgBox SubjectDate
    objRS.MoveNext
    Loop
    Set objRS = Nothing
    Set objConn = Nothing
    End Sub
    [/vba]


    [vba]
    msg.Subject = "Date - " & SubjectDate
    [/vba]
    Thanks. Haven't tried it yet. Quick question: I have multiple files that need this functionality - do I need to create seperate GetExcelConnection() macros in each module, or can I just put it in the "ThisOutlookSession" object?
    I use Excel / Outlook 2007.

  4. #4
    VBAX Expert
    Joined
    Aug 2004
    Posts
    751
    Location
    [VBA]
    Sub test()
    Dim objRS As ADODB.Recordset
    Dim strConn As String
    Dim objConn As ADODB.Connection
    Dim SubjectDate As Date
    Dim Index As Long
    Dim Files() As Variant
    Files = Array("c:\test.xls", "c:\test2.xls")
    'To read a sheet:
    ' strRequest = "SELECT * FROM Sheet1$"

    'To refer to a range by its address:
    ' strRequest = "SELECT * FROM [Sheet1$A110]"
    'To refer to a single-cell range, pretend it's a multi-cell range
    'and specify both the top-left and bottom-right cells:
    strRequest = "SELECT * FROM [Sheet1$A1:A1]"

    'To read a named range:
    ' strRequest = "SELECT * FROM MyDataRange"

    'To read a worksheet-level named range
    ' strRequest = "SELECT * FROM [Sheet1$MyData]"
    For Index = LBound(Files) To UBound(Files)
    Set objConn = GetExcelConnection(Files(Index), False)
    'and then just open a recordset
    Set objRS = objConn.Execute(strRequest)
    objRS.MoveFirst
    Do While Not objRS.EOF
    SubjectDate = objRS.Fields(0).Value
    MsgBox SubjectDate
    objRS.MoveNext
    Loop
    Set objRS = Nothing
    Set objConn = Nothing
    Next Index
    End Sub

    [/VBA]

    With a slight change to the TEST subroutine, you can pickup your data with one shot. Basically, put in your list of files into your array and then step it thru and output the content of A1

  5. #5
    Quote Originally Posted by JKwan
    [vba]
    Sub test()
    Dim objRS As ADODB.Recordset
    Dim strConn As String
    Dim objConn As ADODB.Connection
    Dim SubjectDate As Date
    Dim Index As Long
    Dim Files() As Variant
    Files = Array("c:\test.xls", "c:\test2.xls")
    'To read a sheet:
    ' strRequest = "SELECT * FROM Sheet1$"

    'To refer to a range by its address:
    ' strRequest = "SELECT * FROM [Sheet1$A110]"
    'To refer to a single-cell range, pretend it's a multi-cell range
    'and specify both the top-left and bottom-right cells:
    strRequest = "SELECT * FROM [Sheet1$A1:A1]"

    'To read a named range:
    ' strRequest = "SELECT * FROM MyDataRange"

    'To read a worksheet-level named range
    ' strRequest = "SELECT * FROM [Sheet1$MyData]"
    For Index = LBound(Files) To UBound(Files)
    Set objConn = GetExcelConnection(Files(Index), False)
    'and then just open a recordset
    Set objRS = objConn.Execute(strRequest)
    objRS.MoveFirst
    Do While Not objRS.EOF
    SubjectDate = objRS.Fields(0).Value
    MsgBox SubjectDate
    objRS.MoveNext
    Loop
    Set objRS = Nothing
    Set objConn = Nothing
    Next Index
    End Sub

    [/vba]

    With a slight change to the TEST subroutine, you can pickup your data with one shot. Basically, put in your list of files into your array and then step it thru and output the content of A1
    What if some of my files are picking up from different cells? (Text1.xls picks up from A1, Test2 picks up from B4, etc). The cells all have the same value though, so would I just use your original code and just pick it all up from Test1.xls?

    If I did this, then Test1.xls would not be attached in all of my e-mails. It would be Test2.xls, etc. Is this a problem? Does the file have to be attached?

    Also, the cell I am picking up is a date value. How does this get formatted in Outlook? How would I change the formatting if I wanted to? (In excel I would just use TEXT(A1, "mm-dd-yyyy"). Thanks again.
    I use Excel / Outlook 2007.

  6. #6
    VBAX Expert
    Joined
    Aug 2004
    Posts
    751
    Location
    If I were you, I would use the second set of codes and just read the first value to get your date. In the For loop, only read the file if Index = 0, then you can attach the files to your email - if that is your intent. Otherwise, scrap the For loop and use Files(0) and get the data from your Excel file.
    To get the right date format, after you read cell A1 into SubjectDate, just use the Format on it.

  7. #7
    Quote Originally Posted by JKwan
    If I were you, I would use the second set of codes and just read the first value to get your date. In the For loop, only read the file if Index = 0, then you can attach the files to your email - if that is your intent. Otherwise, scrap the For loop and use Files(0) and get the data from your Excel file.
    To get the right date format, after you read cell A1 into SubjectDate, just use the Format on it.
    I put the GetExcelConnection() Method in object "ThisOutlookSession", and this is what I get:

    I use Excel / Outlook 2007.

  8. #8
    VBAX Expert
    Joined
    Aug 2004
    Posts
    751
    Location
    Did you add reference to Microsoft ActiveX Data Object 2.x?

  9. #9
    Quote Originally Posted by JKwan
    Did you add reference to Microsoft ActiveX Data Object 2.x?
    Which one? I show many. (2.8? It looks like it's the most recent).

    I use Excel / Outlook 2007.

  10. #10
    VBAX Expert
    Joined
    Aug 2004
    Posts
    751
    Location
    Yes, use 2.8

  11. #11
    Quote Originally Posted by JKwan
    Yes, use 2.8
    Doesn't work. Instead of putting the date in the email subject, a message box pops up with the date:



    I put the Add_Date (Formerly Test()) function and the GetExcelConnection function in its own module.

    [VBA]Sub Send_Report()
    Dim msg As Outlook.MailItem
    Set msg = Application.CreateItem(olMailItem)
    Add_Date
    msg.Subject = "Date: " & strRequest
    msg.To = "Joe@aol.com"
    msg.CC = "Bob@gmail.com"
    msg.Display
    End Sub[/VBA]
    I use Excel / Outlook 2007.

  12. #12
    VBAX Expert
    Joined
    Aug 2004
    Posts
    751
    Location
    I just showed you how to read the Excel and get the data that you required. Now, put the code together and you will have your subject line.

  13. #13
    Quote Originally Posted by JKwan
    I just showed you how to read the Excel and get the data that you required. Now, put the code together and you will have your subject line.
    Ok I figured it out. Thanks! =]

    (I had to create a module in the excel file and paste this code in there, that way I can do it from Excel, not Outlook)

    [VBA]
    Sub Send_Mail()
    ' Don't forget to copy the function RangetoHTML in the module.
    ' Working in Office 2000-2007
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
    .To = "Email@email.com"
    .CC = "Email2@email.com"
    .BCC = ""
    .Subject = "Date: " & Sheets("Sheet1").Range("F1").Value
    .Body = "Contact me with questions."
    .Attachments.Add ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    '.Send 'or use .Display
    .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-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 xublishsource=", _
    "align=left xublishsource=")

    '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

    [/VBA]
    Last edited by NYCAnalyst; 10-10-2008 at 06:56 PM.
    I use Excel / Outlook 2007.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •