• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro edit

J

Jagadeeshbs

Member
Hi all


I have below macro which i was using previously, now i need to delete the open outlook mail for this and i just need to create the different file in the same location as before.

Please help me with this:

Sub ExportEmailManual()

Dim ObjFile As FileSystemObject
Dim x, xDate, z
Dim xNewFolder
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim Rng As Range
Dim objOLAttach As Outlook.Attachment
Dim NameX As Name, xDir, xFile, xMonth, xPath, xStp, xDist
Dim xEmailTo, xEmailCC, xEmailBCC, xCurrentName

Application.DisplayAlerts = False

Sheets("UserMaster").Visible = True
Sheets("UserMaster").Select

Range("A2").Select
Do While ActiveCell.Value <> "" Or ActiveCell.Value <> vbNullString
xCurrentName = ActiveCell.Value
x = ActiveWorkbook.Name

xDate = Date

Application.StatusBar = "Preparing Email Attachment..."
Application.ScreenUpdating = False

Sheets("InterCompany Recon rpt").Select
Range("A2").Value = xCurrentName
Application.Calculation = xlCalculationAutomatic

Sheets(Array("InterCompany Recon rpt")).Copy
Sheets(Array("InterCompany Recon rpt")).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Range("A1").Select
Rows("1:3").Delete
Columns("A:C").Delete
Columns("A:A").Insert xlShiftToRight
Columns("A:A").ColumnWidth = 1
Range("A4").Select
Do While ActiveCell.Row < 24
ActiveCell.Offset(0, 10).Formula = "=IF(ISERROR(" & ActiveCell.Offset(0, 4).Address & "+" & ActiveCell.Offset(0, 7).Address & "),0, " & ActiveCell.Offset(0, 4).Address & "+" & ActiveCell.Offset(0, 7).Address & ")"
ActiveCell.Offset(0, 12).Formula = "=IF(ISERROR(" & ActiveCell.Offset(0, 10).Address & "*" & ActiveCell.Offset(0, 11).Address & "),0, " & ActiveCell.Offset(0, 10).Address & "*" & ActiveCell.Offset(0, 11).Address & ")"
ActiveCell.Offset(1, 0).Select
Loop
z = ActiveWorkbook.Name

Windows(z).Activate
Range("A1").Select

Sheets("InterCompany Recon rpt").Select

Application.CutCopyMode = False

Dim nName As Name
For Each nName In Names
nName.Delete
Next nName
xDir = "C:SavedReports" & Format(xDate, "yyyy") & ""

xMonth = Format(xDate, "mm mmmm")
xFile = "CHReport_" & xCurrentName & Format(xDate, "dd-mm-yyyy") & ".xlsx"
xPath = xDir & xMonth & xFile

Set ObjFile = New FileSystemObject

If ObjFile.FolderExists(xDir & xMonth) Then
If ObjFile.FileExists(xPath) Then
ObjFile.DeleteFile (xPath)
Application.Workbooks(z).SaveAs Filename:=xPath
Application.ActiveWorkbook.Close
Else
Application.Workbooks(z).SaveAs Filename:=xPath
Application.ActiveWorkbook.Close
End If
Else
xNewFolder = xDir & xMonth
MkDir xNewFolder
Application.Workbooks(z).SaveAs Filename:=xPath
Application.ActiveWorkbook.Close
End If

Workbooks(x).Activate

Set olApp = New Outlook.Application
Dim olNs As Outlook.Namespace
Set olNs = olApp.GetNamespace("MAPI")
olNs.Logon
Set olMail = olApp.CreateItem(olMailItem)

olMail.To = [sendMailTo]

olMail.Subject = " Intercompany reconciliation report for " & MonthName(DatePart("m", Date) - 1) + Str(Year(Date))
olMail.Body = "Dear All," _
& vbCrLf & vbCrLf & "Please find the attached Intercompany Reconciliation Report for " _
& vbCrLf & vbCrLf & "Regards," _
& vbCrLf & "Jagadeesh B S " _
& vbCrLf & "" _
& vbCrLf & vbCrLf

olMail.Attachments.Add xPath

Range("A1").Select

olMail.Display

Sheets("Usermaster").Select
ActiveCell.Offset(1, 0).Select
Loop
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Please help me with this ....


please see the sample file here.


https://docs.google.com/file/d/0B4WaaVJwF8R_WU9LY1ItZHhTbEE/edit?usp=sharing
 
Hi, Jagadeeshbs!


Are you very hurried? If so please take a break and dedicate 5 minute to what follows. Posting without adding any useful information just for bumping up a topic doesn't guarantee neither a faster assistance nor getting the interest of people who might be reading that post, but rather the opposite effect of discouraging them.


If you'd have read the main green sticky post at this forums main page...

http://chandoo.org/forums/topic/phd-forum-posting-rules-etiquette-pls-read-before-posting

...you should have noticed this points (and if you did it seems as if you should do it again):


"Consider that the world is operating 24hrs a day. A late post today may well be answered by someone else overnight."


"If you and a reader have been involved in an ongoing conversation and the conversation suddenly stops, recognize that the person may have gone to bed, even though you have just arrived at work. In the worst case a reader may go on holidays and not get back to the question for a few days."


"Never title your posts as "Urgent", "Priority" "Immediate". It may be Important to you, but not for rest of the members here. These words will be moderated out."


"Say "Thanks", whenever you can. Recognize when someone has bothered to go to the trouble and time to assist you with your question for free. Often readers will spend several hours working on a solution to a problem, a line of recognition will go a long way."


Regards!
 
Dear


File name will be done on this line


xMonth = Format(xDate, "mm mmmm")

xFile = "CHReport_" & xCurrentName & Format(xDate, "dd-mm-yyyy") & ".xlsx"

xPath = xDir & xMonth & xFile


xFile is your file name. Kindly change as per your requirement
 
Thanks SirJB7


thank you very much Vijay for your time and effort. but my problem is not yet solved. i guess i need to do it manually .
 
You must log in or register to reply here.
Back
Top