I have a Business Object Report that outputs to an Excel spreadsheet. I
want to format the spreadsheet and save it before sending it out to
users.
The problem I have is that when I finish with the formatting, I cannot
close the Excel Application. It also asks me if I want to save the
file, when I go the the Excel Application. Below is the code I am
using.
Could anybody olease help?
Sub EmailReport()
On Error GoTo Emsg
Dim doc As Document
Dim body As String
Dim ReportName As String
Dim locPath As String
Dim objExcel As Object
Dim myObjExcel As Excel.Worksheet
Dim myObjWorkBook As Excel.Workbooks
dDate = Format((Now() - 27), "mmmm dd, YYYY")
Set doc = ActiveDocument
doc.Refresh
' Set objExcel = GetObject(, "Excel.Application")
' Set objExcel = GetObject(ActiveDocument)
locPath = "\\Fpptc01vgc02\O_drive\Sales\DomSales\Private\Sales
Reporting\"
ReportName = ActiveDocument.Name & ".xls"
'myObjWorkBook.Open
("\\Fpptc01vgc02\O_drive\Sales\DomSales\Private\Sales
Reporting\ActiveDocument.Name")
doc.SaveAs (locPath & "\" & ReportName & ".xls")
'-----------------------------------------------------
'Deleteing old report
'------------------------------------------------------------
MsgBox ReportName
'Kill locPath & "\" & ReportName & ".xls"
GetExcel
'-----------------------------------------------------
'Saving report
'------------------------------------------------------------
'------------------------------------------------------------
'Send via Outlook
'------------------------------------------------------------
Set EmailApp = CreateObject("Outlook.Application")
'Logon to Outlook using specified Profile
EmailProf.Logon "MS Exchange Settings", , False, False
Set EmailProf = EmailApp.GetNameSpace("MAPI")
EmailProf.Logon "MS Exchange Settings", , False, False
'Create new mail item
Set NewMail = EmailApp.CreateItem(olMailItem)
'Set Addressees, Subject & Body of message, Attachments, and Send
' . Separate multiple entries with semicolons
With NewMail
.To = "Hussaini-(E-Mail Removed)"
'.Cc = ""
' Load default message.
.body = "Attached is the report for : " & dDate
.Subject = doc.Name
.Importance = 1
.Attachments.Add (locPath & "\" & ReportName & ".xls")
.Send
End With
Set EmailApp = Nothing
Exit Sub
Emsg:
Open "\\Fpptc01vgc02\O_drive\Sales\DomSales\Private\Sales
Reporting\Scheduled Reports\Temp\Global-error.txt" For Output As #1
Print #1, Err.Number; Err.Description
MsgBox Err.Number & " " & Err.Description
Close #1
End Sub
Sub GetExcel()
Dim MyXL As Object
Dim ExcelWasNotRunning As Boolean
Dim ExcelSheet As Excel.Worksheet
On Error Resume Next
Set MyXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear
Set MyXL = CreateObject("Excel.Application")
' MyXL.Application.Visible = True
'DetectExcel
Set MyXL = GetObject("O:\Sales\DomSales\Private\Sales
Reporting\Email Reporting.xls")
Dim myRange As Integer
myRange = 33
'myExcel.
MyXL.Application.Visible = True
MyXL.Parent.Windows(1).Visible = True
MyXL.Application.Sheets(1).Range("A1:A2000").Delete =
True
MyXL.Application.Sheets(1).Range("A3:H7").Font.Bold =
True
'MyXL.Application.Sheets(1).Range("J3:J3").Cut
'MyXL.Application.Sheets(1).Range("A3:A3").Paste
'Move Company Name
MyXL.Application.Sheets(1).Range("A3:A3").Value =
MyXL.Application.Sheets(1).Range("J3:J3").Value
MyXL.Application.Sheets(1).Range("J3:J3").Value = ""
'Move Print Date and Time
MyXL.Application.Sheets(1).Range("G6:G6").Value =
MyXL.Application.Sheets(1).Range("J6:J6").Value
MyXL.Application.Sheets(1).Range("J6:J6").Value = ""
MyXL.Application.Sheets(1).Range("A6:A6").Value =
MyXL.Application.Sheets(1).Range("M6:M6").Value
MyXL.Application.Sheets(1).Range("M6:M6").Value = ""
MyXL.Application.Sheets(1).Save
MyXL.Apllication.Sheets(1).Close
Set MyXL = Nothing
MyXL.Application.Close
MyXL.Application.Quit
End Sub
|
Similar Threads
