Help with Syntax in Code
 

I found the code string below a while back and don't remember the author. My
apologies for the lack of acknowledgement. This code sends workbooks to users
through Outlook. It works fine, but I wanted to customize it slightly. In the
line of code that begins with ".From" I want to enter a cell reference in a
workbook rather than have the sender's name hard coded. I tried:

..From = ThisWorkbook.Sheets(1).Range("F27").Value

and a couple of other variations, but can't get it to accept this cell
reference.

Anyone have the solution?
TIA.

-------------------------

Sub CDO_Mail_Every_Worksheet_File()
Dim iMsg As Object
Dim iConf As Object
Dim ws As Worksheet
Dim wb As Workbook
Dim WBname As String
Dim Flds As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"SMTP.va.gov"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") =
25
.Update
End With

For Each ws In ActiveWorkbook.Worksheets
If ws.Range("A3").Value Like "?*@?*.?*" Then
ws.Copy
Set wb = ActiveWorkbook
WBname = "C:/Personal/" & ws.Name & ".xls"
wb.SaveAs WBname
wb.Close False
Set wb = Nothing

Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = ws.Range("A3").Value
.CC = ThisWorkbook.Sheets(1).Range("F27").Value
.From = """Ken Hudson"" "
.Subject = "FCP User Validation for " & ws.Name
.AddAttachment WBname
.TextBody = ThisWorkbook.Sheets(1).Range("A30")
.Send
End With
Set iMsg = Nothing
Kill WBname
End If
Next ws

Set iConf = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


--
Ken Hudson

Help with Syntax in Code
 

Hi Tom,
Always good to know you are "listening."
Usual problem - I didn't think enough about it or try enough solutions. I
didn't have a "good" E-mail address in the workbook cell. Once I put
, everytthing worked fine.
Thanks for the response.

--
Ken Hudson


"Tom Ogilvy" wrote:

.From = ThisWorkbook.Sheets(1).Range("F27").Value

should work if the address is in the workbook containing the code on the
first sheet in range F27. What's the problem?

--
Regards,
Tom Ogilvy


"Ken Hudson" wrote:

I found the code string below a while back and don't remember the author. My
apologies for the lack of acknowledgement. This code sends workbooks to users
through Outlook. It works fine, but I wanted to customize it slightly. In the
line of code that begins with ".From" I want to enter a cell reference in a
workbook rather than have the sender's name hard coded. I tried:

.From = ThisWorkbook.Sheets(1).Range("F27").Value

and a couple of other variations, but can't get it to accept this cell
reference.

Anyone have the solution?
TIA.

-------------------------

Sub CDO_Mail_Every_Worksheet_File()
Dim iMsg As Object
Dim iConf As Object
Dim ws As Worksheet
Dim wb As Workbook
Dim WBname As String
Dim Flds As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"SMTP.va.gov"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") =
25
.Update
End With

For Each ws In ActiveWorkbook.Worksheets
If ws.Range("A3").Value Like "?*@?*.?*" Then
ws.Copy
Set wb = ActiveWorkbook
WBname = "C:/Personal/" & ws.Name & ".xls"
wb.SaveAs WBname
wb.Close False
Set wb = Nothing

Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = ws.Range("A3").Value
.CC = ThisWorkbook.Sheets(1).Range("F27").Value
.From = """Ken Hudson"" "
.Subject = "FCP User Validation for " & ws.Name
.AddAttachment WBname
.TextBody = ThisWorkbook.Sheets(1).Range("A30")
.Send
End With
Set iMsg = Nothing
Kill WBname
End If
Next ws

Set iConf = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


--
Ken Hudson