Data from other sheet to copy into email

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,227
Office Version
  1. 2010
Platform
  1. Windows
Hi wondering if you can help me please with the code in BOLD, i am trying to grab the data from 'Work Issue' sheet from A1 to I then down to last, but it doesnt seem to be grabbing it and pasting into my email, everything else works apart from the little bit of code in bold, please can you help me? thanks for your time

HTML:
Private Sub CommandButton1_Click()

    Const PR_SECURITY_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x6E010003"
    
    Dim aOutlook As Object
    Dim aEmail As Object
    Dim ulFlags As Integer
    Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
    Dim rngDataToEmail As Range
    
    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    
        With Sheets("Work Issue")
        Set rngDataToEmail = .Range("A1:I" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
    
    ulFlags = ulFlags Or &H1 ' SECFLAG_ENCRYPTED
    
    aEmail.PropertyAccessor.SetProperty PR_SECURITY_FLAGS, (ulFlags)


          aEmail.HTMLBody = "<html>******>" & _
                            "<p>Hi " & Me.TextBox35.Value & "</p>" & _
                            "<p>" & Me.TextBox33.Value & "</p>" & _
                            "<p>" & Me.TextBox17.Value & "</p>" & _
                            "<table border=""1"", cellpadding=""10"", style=background:""#a6bbde"" >" & _
                "<tr>" & _
                            "<th>Date:</th>" & _
                            "<td>" & Me.TextBox18.Text & "</td><td>" & Me.TextBox19.Text & "</td>" & _
                            "<td>" & Me.TextBox21.Text & "</td><td>" & Me.TextBox23.Text & "</td>" & _
                            "<td>" & Me.TextBox25.Text & "</td><td>" & Me.TextBox26.Text & "</td>" & _
                            "</tr>" & _
                "<tr>" & _
                            "<th>Area:</th>" & _
                            "<td>" & Me.TextBox9.Value & "</td><td>" & Me.TextBox20.Value & "</td>" & _
                            "<td>" & Me.TextBox22.Value & "</td><td>" & Me.TextBox24.Value & "</td>" & _
                            "<td>" & Me.TextBox29.Value & "</td><td>" & Me.TextBox30.Value & "</td>" & _
                            "</tr>" & _
                            "</table>" & _
                "<br><br><br><br><br><br>" & _
                "<p>Many Thanks</p>" & _
                "<p>Complex Team</p>" & _
                "</body></html>"


        aEmail.Recipients.Add (UserForm1.TextBox36.Value)
        aEmail.CC = (UserForm1.TextBox37.Value)
        aEmail.BCC = ""
        aEmail.Subject = "Weekly " & Range("D2").Value & (UserForm1.TextBox39.Value)
        aEmail.Display
        
[code]
[/code]
       
Unload Me

End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
oops it didnt highlight the code in bold the code that is not working from above is

Code:
       With Sheets("Work Issue")
        Set rngDataToEmail = .Range("A1:I" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
 
Upvote 0
Hi all just wodnering if you have any ideas please why the above code isn't working? hope you can help, if you need any more information please let me know. thank you for your time:)
 
Upvote 0
Hi sorry just wondering if you can possibly help please as I don't understand why it is not working. The full code is in my first thread then the part that is not working is in the second. I hope you can have a look and help me please.
 
Upvote 0
Hello goood morning, i have tried changing the code to....
Code:
With Sheets("Work Issue")
to
Code:
With Thisworkbook Sheets("Work Issue")
and
Code:
With WorkSheets("Work Issue")

But this still hasn't worked, hope you can advise and help.
 
Upvote 0
Hi

This s very difficult to reply to due to all the criteria in your email been based in text boxes, so its very difficult to recreate the issue your having, my only suggestion is to add the following

Code:
aHTMLBody = rngDataToEmail
[\code]

Giving you
[code]
        aEmail.Recipients.Add (UserForm1.TextBox36.Value)
        aEmail.CC = (UserForm1.TextBox37.Value)
        aEmail.BCC = ""
        aEmail.Subject = "Weekly " & Range("D2").Value & (UserForm1.TextBox39.Value)
aHTMLBody = rngDataToEmail
        aEmail.Display

At least using this i was able to create an email from your code, having stripped out everything ells

Paul
 
Last edited:
Upvote 0
hi thank you for the reply much appreciated, i have added in the code above below the Subject but please can you advise where i add the other code below please.
Code:
       With Sheets("Work Issue")
        Set rngDataToEmail = .Range("A1:I" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
 
Upvote 0
hiya definately alot of criteria in my coding thank you again for looking and your help, i havn't used that snippet of code you have supplied before please advise how i add the
Code:
sheet("Work Issue") and  the .Range("A1:I" & .Range("A" & Rows.Count).End(xlUp).Row)

Thank you again
 
Upvote 0
will it be something like this code below? it doesn't work though which i put together, if this is sort of correct can you help please :)
Code:
aHTMLBody = rngDataToEmail Worksheets("Work Issue") .Range("A:I" & .Range("A" & Rows.Count).End(xlUp).Row)
 
Upvote 0
Hi sorry I don't understand where I need to put the other code. Please can you help.
Code:
 With Sheets("Work Issue")
        Set rngDataToEmail = .Range("A1:I" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With[\CODE]
 
Upvote 0

Forum statistics

Threads
1,214,992
Messages
6,122,631
Members
449,095
Latest member
bsb1122

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top