Need Help with this program to create unique workbook, save, mail and delete

ksghumaria

New Member
Joined
Sep 9, 2014
Messages
9
Hi I'm trying to modify the excel program to copy customised worksheet in new workbook, saving it as temp then mailing this workbook and then deleting it.
I am having following difficulties:
1. If- else if statement not working
2. Showing object error

Sub Send_sheet()

Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim DataWB As Worksheet
Dim Cws As Worksheet
Dim Rcount As Long
Dim Rnum As Long
Dim FilterRange As Range
Dim FieldNum As Integer
Dim NewWB As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim k As Worksheet
Dim product

On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")

With Application
.EnableEvents = False
.ScreenUpdating = True

End With

Set DataWB = Sheets("DATA")
Set FilterRange = DataWB.Range("A1:K" & DataWB.Rows.Count)
FieldNum = 2 'Filter column = B because the filter range start in column A

Set Cws = Worksheets.Add
Cws.Name = "Email IDs"

FilterRange.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Cws.Range("A1"), _
CriteriaRange:="", Unique:=True

Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))
If Rcount >= 2 Then
For Rnum = 2 To Rcount
product = Sheets("DATA").Cells(Rnum, 4)
'If the unique value is a mail addres create a mail
If Cws.Cells(Rnum, 1).Value Like "?*@?*.?*" Then

'Filter the FilterRange on the FieldNum column
FilterRange.AutoFilter Field:=FieldNum, _
Criteria1:=Cws.Cells(Rnum, 1).Value

'Copy the visible data in a new workbook
With DataWB.AutoFilter.Range
On Error Resume Next
'MsgBox (product)
If product = 1000 Or 3000 Then
Sheets("A").Select
ElseIf product = 2000 Then
Sheets("B").Select
ElseIf product = 4000 Then
Sheets("C”).Select
End If
Range("C5").Value = Sheets("DATA").Cells(Rnum, 1).Value
Range("C6").Value = Sheets("DATA").Cells(Rnum, 3).Value
Range("C9").Value = Sheets("DATA").Cells(Rnum, 7).Value
Range("C12").Value = Sheets("DATA").Cells(Rnum, 5).Value
Range("E16").Value = Sheets("DATA").Cells(Rnum, 8).Value
Range("E18").Value = Sheets("DATA").Cells(Rnum, 9).Value
Range("E19").Value = Sheets("DATA").Cells(Rnum, 10).Value
Range("E23").Value = Sheets("DATA").Cells(Rnum, 11).Value
Range("I18").Value = 12
k = ActiveSheet.copy
On Error GoTo 0
End With

NewWB = Workbook.Add ' showing error

ThisWorkbook.Sheets.k.Copy before:=NewWB.Sheets(1) 'showing error
Application.CutCopyMode = False
Range("A4").Select
ActiveWindow.FreezePanes = True

'Create a file name
TempFilePath = Environ$("temp") & "\"
TempFileName = DataWB.Parent.Name _
& " " & Format(Now, "dd-mmm-yy h-mm-ss")

If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
FileExtStr = ".xlsx": FileFormatNum = 51
End If

'Save, Mail, Close and Delete the file
Set OutMail = OutApp.CreateItem(0)

With NewWB
.SaveAs TempFilePath & TempFileName _
& FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = Cws.Cells(Rnum, 1).Value
.Subject = "XYZABC12345"
.Attachments.Add NewWB.FullName
.Body = "Hello Everyone”
.display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Set OutMail = Nothing
Kill TempFilePath & TempFileName & FileExtStr
End If

'Close AutoFilter
DataWB.AutoFilterMode = False

Next Rnum
End If

cleanup:
Set OutApp = Nothing
Application.DisplayAlerts = False
Cws.Delete
Application.DisplayAlerts = True

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
 
Last edited:

Some videos you may like

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,110
Office Version
  1. 365
Platform
  1. Windows
Hi

Try:

Code:
If product = 1000 Or product = 3000 Then
 

ksghumaria

New Member
Joined
Sep 9, 2014
Messages
9
Hey Steve
Thank for the reply.
Perfect answer, it works..
Thanks a lot :) .

Please help with the NewWB code. :rolleyes::)
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,110
Office Version
  1. 365
Platform
  1. Windows
Which sheet are you trying to copy there?
 

ksghumaria

New Member
Joined
Sep 9, 2014
Messages
9

ADVERTISEMENT

The sheet 'if- Then-elseif' condition selects. That will become the active sheet,I want that sheet to be converted as new workbook for mailing.
 

ksghumaria

New Member
Joined
Sep 9, 2014
Messages
9
Need Help with the Program. How to save unique sheets, save in temp, email and delete. Please Help!!:confused::rolleyes:
 

Watch MrExcel Video

Forum statistics

Threads
1,109,367
Messages
5,528,271
Members
409,813
Latest member
robyrux

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top