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