title: VBA script in Excel to populate the .from field from a cell in the worksheet
body: <p>I have sucessfully configured a VBA script based on an example from <a href="http://www.rondebruin.nl" rel="nofollow">http://www.rondebruin.nl</a> to send a copy of an active worsheet in excel as an attachment using a gmail account and CDO.</p>
  
  <p>What I would like to modify is the ability to alter the .From field with the email address of the user that fills out the spreadsheet.  The email address will be filled in the spreadsheet as a part of the process.  Right now, I can only have the .From field populate with a hard coded email address or the email address of the SMTP account being used to send the attachment.</p>
  
  <p>Is my idea possible?</p>
  
  <p>Here is my code as of now.</p>
  
  <pre><code>Option Explicit
  
  
  'This procedure will send the ActiveSheet in a new workbook
  'For more sheets use : Sourcewb.Sheets(Array("Sheet1", "Sheet3")).Copy
  
  Sub CDO_Mail_ActiveSheet_Or_Sheets()
  'Working in 97-2007
  Dim FileExtStr As String
  Dim FileFormatNum As Long
  Dim Sourcewb As Workbook
  Dim Destwb As Workbook
  Dim TempFilePath As String
  Dim TempFileName As String
  Dim iMsg As Object
  Dim iConf As Object
  Dim Flds As Variant
  
  With Application
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  
  Set Sourcewb = ActiveWorkbook
  
  'Copy the ActiveSheet to a new workbook
  ActiveSheet.Copy
  
  'Or if you want to copy more then one sheet use:
  'Sourcewb.Sheets(Array("Sheet1", "Sheet3")).Copy
  
  Set Destwb = ActiveWorkbook
  
  'Determine the Excel version and file extension/format
  With Destwb
      If Val(Application.Version) &lt; 12 Then
          'You use Excel 97-2003
          FileExtStr = ".xls": FileFormatNum = -4143
      Else
          'You use Excel 2007
          'We exit the sub when your answer is NO in the security dialog that you only
          'see  when you copy a sheet from a xlsm file with macro's disabled.
          If Sourcewb.Name = .Name Then
              With Application
                  .ScreenUpdating = True
                  .EnableEvents = True
              End With
              MsgBox "Your answer is NO in the security dialog"
              Exit Sub
          Else
              Select Case Sourcewb.FileFormat
              Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
              Case 52:
                  If .HasVBProject Then
                      FileExtStr = ".xlsm": FileFormatNum = 52
                  Else
                      FileExtStr = ".xlsx": FileFormatNum = 51
                  End If
              Case 56: FileExtStr = ".xls": FileFormatNum = 56
              Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
              End Select
          End If
      End If
  End With
  
  '    'Change all cells in Destwb to values if you want
  '    For Each sh In Destwb.Worksheets
  '        sh.Select
  '        With sh.UsedRange
  '            .Cells.Copy
  '            .Cells.PasteSpecial xlPasteValues
  '            .Cells(1).Select
  '        End With
  '        Application.CutCopyMode = False
  '    Next sh
  '    Destwb.Worksheets(1).Select
  
  
  'Save the new workbook/Mail it/Delete it
  TempFilePath = Environ$("temp") &amp; "\"
  TempFileName = "FRAT 135 Helo" &amp; Format(Now, "dd-mmm-yy h-mm-ss")
  'TempFileName = "Part of " &amp; Sourcewb.Name &amp; " " &amp; Format(Now, "dd-mmm-yy h-mm-ss")
  
  With Destwb
      .SaveAs TempFilePath &amp; TempFileName &amp; FileExtStr, FileFormat:=FileFormatNum
      .Close savechanges:=False
  End With
  
  Set iMsg = CreateObject("CDO.Message")
  Set iConf = CreateObject("CDO.Configuration")
  
  iConf.Load -1    ' CDO Source Defaults
  Set Flds = iConf.Fields
  With Flds
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxx@testsite.net"
      .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
  
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
      .Update
  End With
  
  
  With iMsg
      Set .Configuration = iConf
      .To = "safety@xxxx.net"
      .CC = ""
      .BCC = ""
      'I tried this but it doesn't work
      '.From = ThisWorkbook.Sheets("Sheet2").Range("D5").Value
  
      .From = """Insert Name Here"" &lt;test@yahoo.com&gt;"
      .Subject = "FRAT 135 Helo Submission"
      .TextBody = "Hi There"
      .HTMLBody = "&lt;H3&gt;&lt;B&gt;Dear Safety Advisor&lt;/B&gt;&lt;/H3&gt;" &amp; _
                   "The attached spreadsheet has been submitted by a member of your team.&lt;BR&gt;" &amp; _
                  "Please view this and respond as needed"
                  '"&lt;A HREF=""http://www.companywebsite.com""&gt;Corporate Website&lt;/A&gt;"
      .AddAttachment TempFilePath &amp; TempFileName &amp; FileExtStr
      .Send
  End With
  
  
  'Delete the file you have send
  Kill TempFilePath &amp; TempFileName &amp; FileExtStr
  
  With Application
      .ScreenUpdating = True
      .EnableEvents = True
  End With
  </code></pre>
  
  <p>End Sub</p>