Mail Macro

A

Ams

I have two macro's and one of it can split the data in different
sheets according to their values in column and second macro works to
send those splited file to specified e mail address according to
their
sheet names.

Now my problem is in second macro where the macro is defined in
different file and splited data is in other. Giving u the query for
this macro below.....


Please guide me how can i link the macro with splited file


Thanxs in Advance


Sub Mail_Every_Worksheet()
'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 MailAdress As String


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 sh In ThisWorkbook.Worksheets
MailAdress = ""
On Error Resume Next
MailAdress =
Application.WorksheetFunction.VLookup(Int(sh.Name),
Sheets("LookupTable").Range("A1:B500"), 2, False)
On Error GoTo 0
strbody = "Dear All" & vbNewLine & vbNewLine & _
"Please find attached file of Credit/Debit given
to your account on dt" & " " & Format(Now, "dd-mmm-yy") & vbNewLine &
_
" " & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
"Thanks & Regards" & vbNewLine & _
"Ams" & vbNewLine & _
"Operations" & vbNewLine & _
"123456"
If MailAdress Like "?*@?*.?*" Then


sh.Copy
Set wb = ActiveWorkbook


TempFileName = "Daily Credit MIS Dt." & " " & Format(Now,
"dd-mmm-yy") & " " & sh.Name


Set OutMail = OutApp.CreateItem(0)
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = MailAdress
.CC = ""
.BCC = ""
.Subject = "Hi" & " " & sh.Name
.Body = strbody


.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.display 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Set OutMail = Nothing


Kill TempFilePath & TempFileName & FileExtStr
End If
Next sh


Set OutApp = Nothing


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

Ron de Bruin

Hi Ams

For Each sh In ThisWorkbook.Worksheets

This will loop through all worksheets in the workbook with the code

You can use this for the activeworkbook

For Each sh In ActiveWorkbook.Worksheets
 
A

Ams

Still not working

Hope u understand what i am trying to do......

I have a macro file which contains email address against thier client
codes in first sheet & one other file which contains data in diiferent
sheets.

Macro is woking file if all details in one single file (i.e.
LookupTable & details of client code in differst sheets)

But for that i have to copy Lookuptable file & VBA code into that file
and then run macro.....

I want a macro to be execute when i open splited data file and run
macro
 
R

Ron de Bruin

You can use lookup in another file also
Create the formula with both workbooks open
Then close the file with the table and you see that the formula is changed

--

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


Still not working

Hope u understand what i am trying to do......

I have a macro file which contains email address against thier client
codes in first sheet & one other file which contains data in diiferent
sheets.

Macro is woking file if all details in one single file (i.e.
LookupTable & details of client code in differst sheets)

But for that i have to copy Lookuptable file & VBA code into that file
and then run macro.....

I want a macro to be execute when i open splited data file and run
macro
 
A

Ams

Ron

Thanxs for your suggestion

But this is going to my daily activites and i can not keep on changing
the formula regularly. As the same macro is going to used by n number
of ppl in future i want to make more user friendly. Where i Need to
put one button on first which which ask user to open the file which
they want to send through mail and one more button to send that file.


Is it possible

Need ur help on that
 
R

Ron de Bruin

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 Bruin
http://www.rondebruin.nl/tips.htm


Ron

Thanxs for your suggestion

But this is going to my daily activites and i can not keep on changing
the formula regularly. As the same macro is going to used by n number
of ppl in future i want to make more user friendly. Where i Need to
put one button on first which which ask user to open the file which
they want to send through mail and one more button to send that file.


Is it possible

Need ur help on that
 
A

Ams

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.
 
A

Ams

Ron

n e luck on this


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.














- Show quoted text -
Click to expand...
 
R

Ron de Bruin

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
 
A

Ams

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
 
A

Ams

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.
 
R

Ron de Bruin

Does the splited file already exist in a known path ?
Do I understand you correct ?

Or do you want that the user browse to the file ?

--

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


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
 
R

Ron de Bruin

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 Bruin
http://www.rondebruin.nl/tips.htm


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.
 
A

Ams

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

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

Ron de Bruin

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:A500").SpecialCells(xlCellTypeConstants)
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 Bruin
http://www.rondebruin.nl/tips.htm


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

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

Ams

Got error on this line


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:A500").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
 
A

Ams

Got error on this line

For Each cell In
ThisWorkbook.Worksheets("LookupTable").Range("A1:A500").SpecialCells(xlCell­
TypeConstants)
 
R

Ron de Bruin

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 Bruin
http://www.rondebruin.nl/tips.htm



Got error on this line

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

Ams

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?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Small Help Required 0
Got Stuck 3
Auto Mail 0
Change Range in macro 2
file extension shows up twice on attachment 2
Run-time error '1004'??? 7
Macro Running very slow 5
Keeping Conditional fromating When Emailing Using A Control Button 0

Top