Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Help
I have the below code that looks at a cell and if there is an @ symbol, it
generates an email. I have 7 sheets that have the same people and email address on them, I want to do a master email address list and not have to update all 7 sheets. The code works fine when I type the email address in on each sheet, but when I have it pull the addresses from the master list, the macro does not work. I am not sure if it is picking up the formula in the cell and not the contents or what the problem is. Sub InitialFollowUp() Dim OutApp As Object Dim OutMail As Object Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon On Error GoTo cleanup For Each cell In Columns("d").Cells.SpecialCells(xlCellTypeConstant s) If cell.Value Like "?*@?*.?*" And _ LCase(Cells(cell.Row, "f").Value) = "yes" _ And LCase(Cells(cell.Row, "g").Value) = "" Then Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = cell.Value .CC = Cells(cell.Row, "b").Value .Subject = "Initial/Follow-Up Feedback Reminder" .Body = Cells(cell.Row, "c").Value _ & vbNewLine & vbNewLine & _ "You are the supervisor of " & Cells(cell.Row, "A").Value & " an Initial/Follow-Up feedback is due by " & Cells(cell.Row, "e").Value & vbNewLine & vbNewLine & "Please us the attached AF Form 931 to accomplish this feedback. This must be completed by the above date." & vbNewLine & vbNewLine & "After you have completed your feedback, have the ratee and yourself sign the attached Feedback MFR and return to the Deputy Fire Chief." _ & vbNewLine & vbNewLine & _ "Additionally, in accordance with AFI 36-2618, supervisors are required to provide career counseling to subordinates on the benefits, entitlements, and opportunities available in an Air Force career. Counseling occurs in conjunction with performance feedback or when an individual comes up for review under the Selective Reenlistment Program. Provide a copy of the attached compensation fact sheet to each individual after counseling. The fact sheet also contains valuable web links associated with each topic providing additional valuable information. " 'You can add files also like this .Attachments.Add ("F:\feedback\Feedback Form.pdf") .Attachments.Add ("F:\feedback\af931.xfdl") .Attachments.Add ("F:\feedback\Air Force compensation Fact Sheet.pdf") .Display End With On Error GoTo 0 Cells(cell.Row, "g").Value = "X" Set OutMail = Nothing End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Help
I added thisworkboo.activesheet to the code. Try these changes
Sub InitialFollowUp() Dim OutApp As Object Dim OutMail As Object Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Trailer = "Additionally, in accordance with AFI 36-2618, " & _ "supervisors are required to provide career counseling to subordinates on the " & _ "benefits, entitlements, and opportunities available in an Air Force career. " & _ "Counseling occurs in conjunction with performance feedback or when an " & _ "individual comes up for review under the Selective Reenlistment Program. " & _ "Provide a copy of the attached compensation fact sheet to each individual " & _ "after counseling. The fact sheet also contains valuable web links associated " & _ "with each topic providing additional valuable information. " with thisworkbook.activesheet On Error GoTo cleanup For Each cell In .Columns("d").Cells.SpecialCells(xlCellTypeConstan ts) If cell.Value Like "?*@?*.?*" And _ LCase(.Cells(cell.Row, "f").Value) = "yes" _ And LCase(.Cells(cell.Row, "g").Value) = "" Then Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = cell.Value .CC = .Cells(cell.Row, "b").Value .Subject = "Initial/Follow-Up Feedback Reminder" .Body = .Cells(cell.Row, "c").Value _ & vbNewLine & vbNewLine & _ "You are the supervisor of " & _ .Cells(cell.Row,"A").Value & _ " an Initial/Follow-Up feedback is due by " & _ Cells(cell.Row,"e").Value & _ vbNewLine & vbNewLine & _ "Please us the attached AF Form 931 to accomplish this feedback. " & _ "This must be completed by the above date." & _ vbNewLine & vbNewLine & _ "After you have completed your feedback, have the " & _ "ratee and yourself sign the attached Feedback MFR and return to the Deputy " & _ "Fire Chief." & _ vbNewLine & vbNewLine & Trailer 'You can add files also like this .Attachments.Add ("F:\feedback\Feedback Form.pdf") .Attachments.Add ("F:\feedback\af931.xfdl") .Attachments.Add ("F:\feedback\Air Force compensation Fact Sheet.pdf") .Display End With On Error GoTo 0 .Cells(cell.Row, "g").Value = "X" Set OutMail = Nothing End If Next cell end with cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub "jason" wrote: I have the below code that looks at a cell and if there is an @ symbol, it generates an email. I have 7 sheets that have the same people and email address on them, I want to do a master email address list and not have to update all 7 sheets. The code works fine when I type the email address in on each sheet, but when I have it pull the addresses from the master list, the macro does not work. I am not sure if it is picking up the formula in the cell and not the contents or what the problem is. Sub InitialFollowUp() Dim OutApp As Object Dim OutMail As Object Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon On Error GoTo cleanup For Each cell In Columns("d").Cells.SpecialCells(xlCellTypeConstant s) If cell.Value Like "?*@?*.?*" And _ LCase(Cells(cell.Row, "f").Value) = "yes" _ And LCase(Cells(cell.Row, "g").Value) = "" Then Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = cell.Value .CC = Cells(cell.Row, "b").Value .Subject = "Initial/Follow-Up Feedback Reminder" .Body = Cells(cell.Row, "c").Value _ & vbNewLine & vbNewLine & _ "You are the supervisor of " & Cells(cell.Row, "A").Value & " an Initial/Follow-Up feedback is due by " & Cells(cell.Row, "e").Value & vbNewLine & vbNewLine & "Please us the attached AF Form 931 to accomplish this feedback. This must be completed by the above date." & vbNewLine & vbNewLine & "After you have completed your feedback, have the ratee and yourself sign the attached Feedback MFR and return to the Deputy Fire Chief." _ & vbNewLine & vbNewLine & _ "Additionally, in accordance with AFI 36-2618, supervisors are required to provide career counseling to subordinates on the benefits, entitlements, and opportunities available in an Air Force career. Counseling occurs in conjunction with performance feedback or when an individual comes up for review under the Selective Reenlistment Program. Provide a copy of the attached compensation fact sheet to each individual after counseling. The fact sheet also contains valuable web links associated with each topic providing additional valuable information. " 'You can add files also like this .Attachments.Add ("F:\feedback\Feedback Form.pdf") .Attachments.Add ("F:\feedback\af931.xfdl") .Attachments.Add ("F:\feedback\Air Force compensation Fact Sheet.pdf") .Display End With On Error GoTo 0 Cells(cell.Row, "g").Value = "X" Set OutMail = Nothing End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|