Change VBA code to automatically change with whatever results are in Sheet("Blue" 65) A5 with command button

[RLPeloquin]

I have a command button on Sheet(Blue 65) with an email address in A5. I'd like for, once the command button is clicked it would insert their email address from A5 to this line of code. strTo = "YourEmailAddress" Below code is highlighted in red.


Public Function RangeConc(ByRef argRange As Range) As String

If Not argRange Is Nothing Then
For Each c In argRange
sTmp = sTmp & c.Text & vbCrLf
Next c
RangeConc = sTmp
End If
End Function
Sub Send_Email()
Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strBody As String
Dim c As Range
Dim sTmp As String
strSubject = "Results of your power useage"
strFrom = "Fromemail"
strTo = "ToEmail" 'I'd like whatever email is in Sheet(Blue 65")A5
strCc = ""
strBcc = ""
strBody = "Here is a copy of your power usage: " & RangeConc(ActiveSheet.Range("F1,F2,G3,H3,A1,A2,A3,A4,A5,C7,C8,C9,C10"))

Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo Error_Handling
Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1
Set SMTP_Config = CDO_Config.Fields
With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update
End With
With CDO_Mail
Set .Configuration = CDO_Config
End With

CDO_Mail.Subject = strSubject
CDO_Mail.From = strFrom
CDO_Mail.To = strTo
CDO_Mail.TextBody = strBody
CDO_Mail.CC = strCc
CDO_Mail.BCC = strBcc
CDO_Mail.Send
Error_Handling:
If Err.Description <> "" Then MsgBox Err.Description

End Sub

 

[RayFrye]

This should do the trick.

strTo = ActiveWorkbook.Worksheets("Blue 65").Range("A5").Value