Home |
Search |
Today's Posts |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi Mark,
Am Tue, 28 Aug 2018 17:58:05 -0700 (PDT) schrieb Living the Dream: I did a revision of my original code which make it easier for you to understand my end goal. So, the user will select a Cell in Column D of PF-Log, then hit the "Send Email". The code is meant to collect all the strings that will populate the email body. The problem with the following is it throws an error he Dim myCell As Range: Set myCell = ActiveCell < code snipped Try: Sub Mail() Dim Who As String, When As String, LoadID As String, Flow As String, Issue As String, Comment As String, Outcome As String Dim EmailTo As String, EmailCC As String, strBody As String Dim iLoad As String, iPO As String, iVend As String, iSub As String, iDC As String, iWoods As String, iSpaces As String, iWeight As String, iTime As String Dim LRow As Long Dim c As Range Dim OutApp As Object, OutMail As Object Set OutApp = GetObject(, "Outlook.Application") If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.createitem(0) With ActiveCell Who = .Value When = .Offset(, -3).Value LoadID = .Offset(, -2).Value Flow = .Offset(, -1).Value Issue = .Offset(, 1).Value Comment = .Offset(, 2).Value Outcome = .Offset(, 3).Value End With With Sheets("Support") Set c = .Range("D:D").Find(Who, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then EmailTo = .Cells(c.Row, "E") EmailCC = .Cells(c.Row, "F") End If End With With Sheets("Historical") LRow = .Cells(Rows.Count, "A").End(xlUp).Row Set c = .Range("B1:B" & LRow).Find(LoadID, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then iLoad = c.Value iPO = c.Offset(, 1).Value iVend = c.Offset(, 3).Value iSub = c.Offset(, 4).Value iDC = c.Offset(, 5).Value iWoods = c.Offset(, 8).Value iSpaces = c.Offset(, 6).Value iWeight = c.Offset(, 7).Value iTime = c.Offset(, 12).Value End If End With With Application strBody = "Hi " & Who & .Rept(Chr(10), 2) & _ "As per our discussion regarding the following:" & .Rept(Chr(10), 2) & _ "Log Flow:" & .Rept(Chr(32), 15) & Flow & " - Log Date/Time: " & When & .Rept(Chr(10), 2) & _ "Issue:" & .Rept(Chr(32), 22) & Issue & .Rept(Chr(10), 2) & _ "Comment:" & .Rept(Chr(32), 14) & Comment & .Rept(Chr(10), 2) & _ "Vendor:" & .Rept(Chr(32), 18) & iVend & Chr(10) & _ "Load ID:" & .Rept(Chr(32), 18) & iLoad & Chr(10) & _ "PO No(s):" & .Rept(Chr(32), 16) & iPO & Chr(10) & _ "Pallet(s):" & .Rept(Chr(32), 17) & iWoods & Chr(10) & _ "Space(s):" & .Rept(Chr(32), 17) & iSpaces & Chr(10) & _ "Weight:" & .Rept(Chr(32), 19) & iWeight & .Rept(Chr(10), 2) & _ "Collection Time:" & .Rept(Chr(32), 5) & iTime & .Rept(Chr(10), 2) & _ "Bound For:" & .Rept(Chr(32), 14) & iDC & .Rept(Chr(10), 2) & _ "Outcome:" & .Rept(Chr(32), 16) & Outcome End With With OutMail .To = EmailTo .CC = EmailCC .Subject = iVend & " - " & iLoad .Body = strBody .Display '.send now throws up Security Marning so DO NOT USE. End With End Sub Regards Claus B. -- Windows10 Office 2016 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
looking for matches from 2 different sized ranges | Excel Programming | |||
Excel Macro to Email specified ranges | Excel Discussion (Misc queries) | |||
Copy two ranges without the interval rows to the email | Excel Programming | |||
How can I make Outlook Express my primary email for excel? | Excel Discussion (Misc queries) | |||
establishing the background colour of a cell | Excel Discussion (Misc queries) |