C
ca1358 via AccessMonster.com
The first thing that happens, is this created a report from Access Table,
launches Excel, creates Excel TemplateWorkbook(not Saved) named Afterhours.
But when it opens it opens it opens as Afterhours1.Then I need to Email the
ActiveWorkbook named Afterhours or Afterhours1(Still not saved). Is there
away to save this temporally and then use the second part of my code? (To
Send as an Attachment)
Any help would greatly be appreciated
Private Sub Command0_Click()
On Error Resume Next
Dim sCriteria As String
Dim db As Database
Dim rst As Recordset
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim theDate As Date
Dim Dest As Workbook
'In Access Table pick the records to copy over
theDate = InputBox("ENTER DATE MM/DD/YYYY:", "Enter a Date....", Date)
sCriteria = "AFTERHOURS.DATE = #" & theDate & "#"
Set db = CurrentDb()
'Copy Data to New Workbook
Set objBook = Workbooks.Add(Template:=CurrentProject.Path & "\Afterhours.
xlt") 'Your excel spreadsheet file goes here
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("Afterhours") 'Name of sheet you want
to export to
objBook.Windows(1).Visible = True
Set rst = db.OpenRecordset("SELECT DATE, TIME, [COMPANY NAME], [COMPANY #]
, [POOL CD], TERM, COUPON, [COMMITMENT AMT], [POOL MONTH] FROM Afterhours
WHERE " & sCriteria, dbOpenSnapshot) 'dbOpenDynaset dbOpenSnapshot) 'Opens
the recordset and sets the variable
With objSheet
.Range("A2").CopyFromRecordset rst 'rst Copies the recordset into the
worksheet
End With
rst.Close
objApp.Visible = True
'SECOND PART OF CODE
With Dest
'ActiveWorkbook.SendMail Recipients:="email address"
'This example send the last saved version of the Activeworkbook
'You must add a reference to the Microsoft outlook Library
Dim OutApp As Object
Dim OutMail As Object
Dim objoutlook As Object
Dim objoutlookmsg As Object
Dim cell As Range
Dim email_ As String
Dim cc_ As String
Dim subject_ As String
Dim body_ As String
For Each cell In Range("a1:a65536").Cells.SpecialCells
(xlCellTypeConstants)
email_ = cell.Value
cc_ = cell.Offset(0, 1).Value
subject_ = cell.Offset(0, 2).Value
body_ = cell.Offset(0, 3).Value
' attach_ = cell.Offset(0, 4).Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = email_
.Subject = subject_
.Body = body_
.CC = cc_
' .attachments.Add ActiveWorkbook.wb
' .Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
.attachments.Add ("C:\Afterhours.xls")
.Send
'or use
'.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Next
On Error Goto 0
End With
Set rst = Nothing
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing
End Sub
launches Excel, creates Excel TemplateWorkbook(not Saved) named Afterhours.
But when it opens it opens it opens as Afterhours1.Then I need to Email the
ActiveWorkbook named Afterhours or Afterhours1(Still not saved). Is there
away to save this temporally and then use the second part of my code? (To
Send as an Attachment)
Any help would greatly be appreciated
Private Sub Command0_Click()
On Error Resume Next
Dim sCriteria As String
Dim db As Database
Dim rst As Recordset
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim theDate As Date
Dim Dest As Workbook
'In Access Table pick the records to copy over
theDate = InputBox("ENTER DATE MM/DD/YYYY:", "Enter a Date....", Date)
sCriteria = "AFTERHOURS.DATE = #" & theDate & "#"
Set db = CurrentDb()
'Copy Data to New Workbook
Set objBook = Workbooks.Add(Template:=CurrentProject.Path & "\Afterhours.
xlt") 'Your excel spreadsheet file goes here
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("Afterhours") 'Name of sheet you want
to export to
objBook.Windows(1).Visible = True
Set rst = db.OpenRecordset("SELECT DATE, TIME, [COMPANY NAME], [COMPANY #]
, [POOL CD], TERM, COUPON, [COMMITMENT AMT], [POOL MONTH] FROM Afterhours
WHERE " & sCriteria, dbOpenSnapshot) 'dbOpenDynaset dbOpenSnapshot) 'Opens
the recordset and sets the variable
With objSheet
.Range("A2").CopyFromRecordset rst 'rst Copies the recordset into the
worksheet
End With
rst.Close
objApp.Visible = True
'SECOND PART OF CODE
With Dest
'ActiveWorkbook.SendMail Recipients:="email address"
'This example send the last saved version of the Activeworkbook
'You must add a reference to the Microsoft outlook Library
Dim OutApp As Object
Dim OutMail As Object
Dim objoutlook As Object
Dim objoutlookmsg As Object
Dim cell As Range
Dim email_ As String
Dim cc_ As String
Dim subject_ As String
Dim body_ As String
For Each cell In Range("a1:a65536").Cells.SpecialCells
(xlCellTypeConstants)
email_ = cell.Value
cc_ = cell.Offset(0, 1).Value
subject_ = cell.Offset(0, 2).Value
body_ = cell.Offset(0, 3).Value
' attach_ = cell.Offset(0, 4).Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = email_
.Subject = subject_
.Body = body_
.CC = cc_
' .attachments.Add ActiveWorkbook.wb
' .Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
.attachments.Add ("C:\Afterhours.xls")
.Send
'or use
'.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Next
On Error Goto 0
End With
Set rst = Nothing
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing
End Sub