Working perfectly Fine

Thanxs a Ton


On Jan 27, 4:30*am, "Ron de Bruin" wrote:
Hi Ams

Two problems

In your code there is a - in this part

SpecialCells(xlCellType-Constants)

Must be

SpecialCells(xlCellTypeConstants)

*strange it was not in the code I posted

And because you use sheet names with numbers change

SourceWB.Sheets(cell.Value).Copy

To

SourceWB.Sheets(cell.Text).Copy

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ams" wrote in ...

Hi Ron

I have sent files on ur mail address. Kindly chek the same

On Jan 27, 12:02 am, "Ron de Bruin" wrote:



You not have to change anything in the code
Send me the workbook private and i look at it for you tomorrow

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ams" wrote in ...

I have sheet with name ("LoookupTable") in work book with code & there
is also data available in sheet.
When i used the earlier macro then it works find but when i used new
code the macro show error " Unable to get the Specialcell property of
the range class"

have u used Vlookup function in new macro?

On Jan 26, 2:39 am, "Ron de Bruin" wrote:

Then there is no worksheet with that name or there is no data in A1:A500

Note: Worksheets("LookupTable") must be in the same workbook as the code

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ams" wrote in ...

Got error on this line

For Each cell In
ThisWorkbook.Worksheets("LookupTable").Range("A1:A 500").SpecialCells(xlCell****
TypeConstants)

On Jan 25, 3:05 am, "Ron de Bruin" wrote:

OK

Try this one
Copy the macro in the workbook with the sheet LookupTable
You can browse to the file in this example
There is no test if the file is already open in this example

Sub Mail_Every_Worksheet_Ron()
'Working in 2000-2007
Dim sh As Worksheet
Dim WB As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim Strbody As String
Dim cell As Range
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant
Dim SourceWB As Workbook

SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath 'or use "C:\Data"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")

If FName = False Then
'do nothing
Else
Set SourceWB = Workbooks.Open(FName)

TempFilePath = Environ$("temp") & "\"

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

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

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

For Each cell In ThisWorkbook.Worksheets("LookupTable").Range("A1:A 500").SpecialCells(xlCell****TypeConstants)
If cell.Offset(0, 1).Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)

If SheetExists(cell.Value, SourceWB) = True Then
SourceWB.Sheets(cell.Value).Copy
Set WB = ActiveWorkbook

TempFileName = "Daily Credit MIS Dt." & " " & Format(Now, _
"dd-mmm-yy") & " " & cell.Value

WB.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
Strbody = "text and attachment"
Else
Strbody = "text and no attachment"
End If

On Error Resume Next
With OutMail
.To = cell.Offset(0, 1).Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = Strbody
If Not WB Is Nothing Then
.Attachments.Add WB.FullName
End If
.Display 'or use .Display
End With
On Error GoTo 0

If Not WB Is Nothing Then
WB.Close SaveChanges:=False
Set WB = Nothing
Kill TempFilePath & TempFileName & FileExtStr
End If
Set OutMail = Nothing
End If

Next cell

SourceWB.Close False

Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End If
ChDrive SaveDriveDir
ChDir SaveDriveDir

End Sub

Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ams" wrote in ...

Yes... I want user to browse to the file ?

& where do i incorporate 'Function SheetExists' code in current
macro.....

On Jan 24, 9:52 pm, "Ron de Bruin" wrote:

Yes that is possible

We now loop through the sheets but we can also loop through list with sheet names and
then you can use this function to check if the sheet exist

Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

And use something like this in your code

If SheetExists(cell.Value) = True Then
'send sheet
Else
'send simple body mail
End If

If you need more help post back

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ams" wrote in ...

going forward.....

We are sending daily credit files to many client through mails though
it is not necessary that every day all clinets has credit to their
account.In such cases when the customer does not have credit to their
account we used to sent mail saying there is nil credit to your
account.

Is it possible to add such code like if there is no worksheet in
splited file but the mail address is there with clinet code,
To send them simple mail without any attachement saying there is nil
credit to your account.

On Jan 23, 10:25 pm, Ams wrote:

Woking Perfectly Fine
Thanxs alot

Is it possible to make if more user friendly

I want to place one commond buttone to Open the select file & then one
short cut to run macro as i dont want user to go to File menu option
to Open the splited file Or to Tools Macro option to run macro

Thanxs Once again

On Jan 22, 2:52 am, "Ron de Bruin" wrote:

Ok

Two workbooks open
One with the splited data on different sheets (I test with names)
The other workbook with the mail macro

I changed this part of the code

For Each sh In ActiveWorkbook.Worksheets
MailAdress = ""
On Error Resume Next
MailAdress = Application.WorksheetFunction.VLookup(sh.Name, ThisWorkbook.Sheets("LookupTable").Range("A1:B500" ), 2,
False)

Now be sure that the workbook with the splited data is active before you run the code

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ron de Bruin" wrote in . ..

I am very busy

I try to post a example today

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

"Ams" wrote in
...
Ron

n e luck on this

On Jan 20, 1:33 pm, Ams wrote:
Still not successed

if u dont mind pls give me the code which need to be changed.I have
changed thisworkbook to Activeworkbook then also this is not working
& also tell me from which file i have to run a macro? from the splited
file of data or From the main file where VBA code & mail address were
stored in 'LookupTable' sheet.

On Jan 17, 3:00 am, "Ron de Bruin" wrote:

You must change the loop to

For Each sh In ActiveWorkbook.Worksheets

Because thisworkbook point to the workbook with the code and not the workbook
with the splited data.

Then in this part point to the workbook with the code where your table is (I think)

Application.WorksheetFunction.VLookup(Int(sh.Name) ,
Sheets("LookupTable").Range("A1:B500"), 2, False)

It will no look for the Sheets("LookupTable") in the activeworkbook

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ams" wrote in

...

read more »- Hide quoted text -

- Show quoted text -