View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default Email: Establishing Primary Cell vs. Ranges & Matches

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