Hi Bindu,
Please check below code
sub Export
'dim excelFile
'Set the path where the excel will be saved
path= "C:\Users\Desktop\Report"
filePath = path &".xls"
'Create the Excel spreadsheet
set oXL=CreateObject("Excel.Application")
oXL.visible=False
Set curWorkBook= oXL.Workbooks.Add
aSheetObj=Array("CH52")
usedRows=0
oXL.Sheets.Add
Set oSH = oXL.ActiveSheet
oSH.Range("A1").Select
Set obj = ActiveDocument.GetSheetObject(aSheetObj(0))
obj.CopyTableToClipboard True
oSH.Paste
sCaption=obj.GetCaption.Name.v
set obj=Nothing
oSH.Rows("1:1").Select
oXL.Selection.Font.Bold = True
oSH.Cells(1,1).Select
oXL.Selection.Columns.AutoFit
oSH.Range("A1").Select
oSH.Name=left(sCaption,30)
set oSH=Nothing
oXL.Visible = False
oXL.DisplayAlerts = False
'Save the file and quit excel
curWorkBook.SaveAs filePath
curWorkBook.Close
oXL.Quit
'set oXL=Nothing
Dim objEmail
Const cdoSendUsingPort = 2 ' Send the message using SMTP
Const cdoBasicAuth = 1 ' Clear-text authentication
Const cdoTimeout = 60 ' Timeout for SMTP in seconds
mailServer = "Server IP"
SMTPport =25
mailusername = "Mail ID"
'mailpassword = ""
mailto = "To Mail ID list"
mailSubject = "Test mail to test macro"
body = "<html><body> Dear All, <br> <br>Pl find attached<br> </body></html>"
Set objEmail = CreateObject("CDO.Message")
Set objConf = objEmail.Configuration
Set objFlds = objConf.Fields
With objFlds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPport
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasicAuth
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = cdoTimeout
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailusername
.Item("http://schemas.microsoft.com/cdo/configuration/smtpaccountname") = mailusername
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailpassword
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Update
End With
objEmail.To = mailto
objEmail.From = mailusername
'objEmail.CC =
objEmail.Subject = " Report."
objEmail.HTMLBody = body
objEmail.AddAttachment filePath
objEmail.Send
Set objFlds = Nothing
Set objConf = Nothing
Set objEmail = Nothing
Set curWorkBook = nothing
Set oXL= nothing
ActiveDocument.Save
ActiveDocument.GetApplication.Quit
End Sub
