Unable to register subject for email

kobibh

New Member
Joined
May 19, 2020
Messages
2
Office Version
2013
Hello everyone,
I have a VBA code that copies part of a sheet to a new sheet and sends it in Outlook.

My problem is that I can't register subject and body.
.Subject = "Subject"
Thanks to the try and the respondents.

kobi

VBA Code:
Option Explicit


Sub SendEmail()
  'Uses late binding
  Dim OutlookApp As Object
  Dim MItem As Object
  Dim cell As Range
  Dim Subj As String
  Dim EmailAddr As String
  Dim Recipient As String
  Dim Bonus As String
  Dim Msg As String
  Dim y As String
  Dim NameOfWorker As String
  
  'Create Outlook object
  Set OutlookApp = CreateObject("Outlook.Application")
 
 
  'Loop through the rows
  For Each cell In Columns("X").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "*@*" Then
   
      'Get the data

     
       Subj = "New axle variant " & Range(" Y2 ") & " for " & Range(" Y3 ").Value & " is ready for sales processing"
      Recipient = cell.Offset(0, -1).Value
      EmailAddr = cell.Value
      y = cell.Row
      
      NameOfWorker = Cells(y, 5).Value
   
    Dim Source, Source1 As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim I As Long
  
   
   
    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("1:3").SpecialCells(xlCellTypeVisible)
   
    Set Source1 = Rows(y).SpecialCells(xlCellTypeVisible)
   
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
   
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
   

   Source1.Copy
    With Dest.Sheets(1)
        .Cells(4, 1).PasteSpecial Paste:=8
        .Cells(4, 1).PasteSpecial Paste:=xlPasteValues
        .Cells(4, 1).PasteSpecial Paste:=xlPasteFormats
        .Cells(4, 1).Select
        Application.CutCopyMode = False
    End With
   

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "File " & NameOfWorker & " " _
                 & Format(Now, "dd-mmm-yyyy h-mm")


    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If
''MsgBox (Subj)
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail (EmailAddr), _
           [B][SIZE=5] .Subject = "Subject"[/SIZE][/B]
           
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
  
  
    End If
  Next
  Set OutlookApp = Nothing
End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,295
Office Version
2019, 2016, 2013
Platform
Windows
maybe nothing but why are you wrapping the line
.SendMail (EmailAddr), _ <to the left here
.Subject = "Subject"
 

Watch MrExcel Video

Forum statistics

Threads
1,095,727
Messages
5,446,168
Members
405,388
Latest member
Arlind

This Week's Hot Topics

Top