Unable to register subject for email

kobibh

New Member
Joined
May 19, 2020
Messages
5
Office Version
  1. 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:

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
maybe nothing but why are you wrapping the line
.SendMail (EmailAddr), _ <to the left here
.Subject = "Subject"
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,338
Members
448,569
Latest member
Honeymonster123

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top