Email copy and paste code not working

P

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,259
Office Version
  1. 2010
Platform
  1. Windows
Hello :) good afternoon please can you help me i am confuised why my code below is not working hoping you can help me please. I am trying to copy data from a sheet called filter from columns b1 to k and down to last entry, but when i click on my button to do all its stuff in the email its not copying my data across please can you help.

HTML: 
LastRow = Sheets("Filter").Columns("B:K").Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Set rngDataToEmail = Sheets("Filter").Range("B1:K" & LastRow).SpecialCells(xlCellTypeVisible)

Full CODE below

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
    Dim StrBody As String
    
    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    
LastRow = Sheets("Filter").Columns("B:K").Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Set rngDataToEmail = Sheets("Filter").Range("B1:K" & LastRow).SpecialCells(xlCellTypeVisible)
 
    
    ulFlags = ulFlags Or &H1 ' SECFLAG_ENCRYPTED
    
    aEmail.PropertyAccessor.SetProperty PR_SECURITY_FLAGS, (ulFlags)
    


          StrBody = "<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>" & _
                            "</body></html>"
                            



 
StrThanks = "<html>******>" & _
                "<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 " & Sheets("NOTES").Range("D2").Value & (UserForm1.TextBox39.Value)
        aEmail.HTMLBody = StrBody & RangetoHTML(rngDataToEmail) & StrThanks
        aEmail.Display
Unload Me

End Sub
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
Hi can anyone help please? I am still new to this and struggling to why it's not working. Thanks for your time.
 
Upvote 0
.

This URL Const PR_SECURITY_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x6E010003 is no longer in use.

Using this line of code :
LastRow = Sheets("Filter").Columns("B:K").Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Set rngDataToEmail = Sheets("Filter").Range("B1:K" & LastRow).SpecialCells(xlCellTypeVisible)

indicates you are filtering the rows prior to copy/emailing ? Are you filtering rows ? Is it necessary in your project to filter rows ?

This line of code : ulFlags = ulFlags Or &H1 ' SECFLAG_ENCRYPT : indicates you desire to encrypt the email ?


Have you reviewed this excellent website by Ron deBruin ? He wrote the manual of VBA email :

https://www.rondebruin.nl/win/s1/outlook/mail.htm
 
Upvote 0
Hello thanks for your feedback, the security flags and decflag encrypt code i use to encrypt my email when sending so the receiver has to enter their password. The sheet called 'Filter' is filter from another sheet specific which has been filtered by name. I have to filter the data i have by name unfortunately as it needs to be sent to different people. Hope you can help
 
Upvote 0
.
My apologies, I am not familiar with encrypted email.

Hopefully another Forum member can assist.
 
Upvote 0
Hello, good afternoon, just wondering if anyone can help me please I am really stuck to why its not working.
 
Upvote 0
Hi Can anyone help me with this please? I am really stuck and don't understand why it is not working.

This is the code snippet below that I need to work
Code: 
LastRow = Sheets("Filter").Columns("B:K").Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Set rngDataToEmail = Sheets("Filter").Range("B1:K" & LastRow).SpecialCells(xlCellTypeVisible)

and this is the whloe code

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
    Dim StrBody As String
    
    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    
LastRow = Sheets("Filter").Columns("B:K").Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Set rngDataToEmail = Sheets("Filter").Range("B1:K" & LastRow).SpecialCells(xlCellTypeVisible)
 
    
    ulFlags = ulFlags Or &H1 ' SECFLAG_ENCRYPTED
    
    aEmail.PropertyAccessor.SetProperty PR_SECURITY_FLAGS, (ulFlags)
    


          StrBody = "<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>" & _
                            "</body></html>"
                            



 
StrThanks = "<html>******>" & _
                "</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 " & Sheets("NOTES").Range("D2").Value & (UserForm1.TextBox39.Value)
        aEmail.HTMLBody = StrBody & RangetoHTML(rngDataToEmail) & StrThanks
        aEmail.Display
Unload Me

End Sub

I am trying to copy what is in the sheet called 'FILTER' columns B-K and down into the email body, but its not copying over.

i have pressed F8 and can't find the issue.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Email error on border code
Replies
5
Views
363
Patriot2879
P
P
  • Solved
Copy and cut from sheet 'Raised'
Replies
7
Views
412
Patriot2879
P
P
  • Question Question
Email Me. to label and text on two lines issues
Replies
1
Views
301
Micron
M
P
  • Solved
Compile error: method or data member not found
Replies
6
Views
491
Patriot2879
P
P
  • Question Question
putting a snippet of code from one to another somehow
Replies
5
Views
304
Patriot2879
P

Forum statistics

Threads
1,223,885
Messages
6,175,181
Members
452,615
Latest member
bogeys2birdies

Share this page

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