|
Option
Explicit
Private
Sub
Command1_Click()
'Variabeldeklaration för ADO/Jet-Databas.
Dim
cnt
As
ADODB.Connection
Dim
rst
As
ADODB.Recordset
Dim
stSQL
As
String,
stConn
As
String
'Variabeldeklaration för MS Excel.
Dim
xlApp
As
Excel.Application
Dim
xlWBook
As
Excel.Workbook
Dim
xlWSheet
As
Excel.Worksheet
Dim
xlRReport
As
Excel.Range, xlRData
As
Excel.Range
'Variabeldeklaration för MS Word.
Dim
wdApp
As
Word.Application
Dim
wdDoc
As
Word.Document
Dim
rbmReport
As
Word.Range
'Variabeldeklaration för MS Outlook.
Dim
olApp
As
Outlook.Application
Dim
olNewMail
As
Outlook.MailItem
'Instantiering av MS Excel-objekt.
Set
xlApp =
New
Excel.Application
Set
xlWBook = xlApp.Workbooks.Open(App.Path
&
"\Vecka.xls")
Set
xlWSheet = xlWBook.Worksheets("Veckorapport")
With
xlWSheet
'Detta
namgivna cellområdet innehåller tabellen som används.
Set
xlRReport = .Range("Report")
'Detta
namngivna cellområde tar emot data från databasen.
Set
xlRData = .Range("Data")
End
With
'Instantiering av ADO-objekt.
Set
cnt =
New
ADODB.Connection
Set
rst =
New
ADODB.Recordset
stConn =
"Provider=Microsoft.Jet.OLEDB.4.0;"
_
&
"Data Source="
&
App.Path
&
"\DB1.mdb"
&
";"
stSQL =
"SELECT TOP 5 * FROM Production_E1 ORDER BY Prod_Output DESC"
cnt.Open stConn
rst.Open stSQL, cnt
xlRData.CopyFromRecordset rst
rst.Close
cnt.Close
Set
rst =
Nothing
Set
cnt =
Nothing
'Instantiering av MS Word-objekt.
Set
wdApp =
New
Word.Application
Set
wdDoc = wdApp.Documents.Open(App.Path
&
"\Veckorapport.doc")
'När
denna kod exekveras första gången så genereras ett fel då det inte finns
'något
objekt att ta bort.
On
Error
Resume
Next
With
wdDoc
.Unprotect
Password:="XL-Dennis"
With
.InlineShapes(1)
.Select
.Delete
End
With
End
With
On
Error
GoTo
0
'Bokmärket i Word-dokumentet har namngetts till XLReport.
Set
rbmReport = wdDoc.Bookmarks("XLReport").Range
xlRReport.Copy
'Tabellen kopieras till Word-dokumentet som ett bildobjekt.
With
rbmReport
.Select
.PasteSpecial
Link:=False,
DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
End
With
'Aktiverar dokumentskydded och sparar samt stänger dokumentet.
With
wdDoc
.Protect
wdAllowOnlyReading, ,
"XL-Dennis"
.Close SaveChanges:=True
End
With
wdApp.Quit
Set
rbmReport =
Nothing
Set
wdDoc =
Nothing
Set
wdApp =
Nothing
xlWBook.Close SaveChanges:=True
xlApp.Quit
Set
xlRData =
Nothing
Set
xlRReport =
Nothing
Set
xlWBook =
Nothing
Set
xlApp =
Nothing
'Instantiering
av MS Outlook-objekt.
Set
olApp =
New
Outlook.Application
Set
olNewMail = CreateItem(olMailItem)
'Tilldelar vissa egenskaper värden i det skapade e-postet.
With
olNewMail
.Recipients.Add
"XL-Dennis"
.CC =
"Groupteam"
.BCC
=
"Chefen"
.Subject
=
"Veckorapport"
.Body
=
"Rapport
enligt ök."
With
.Attachments
.Add App.Path
&
"\Veckorapport.doc"
.Item(1).DisplayName
=
"Rapport"
End
With
.Save
.Display
End
With
Set
olNewMail =
Nothing
Set
olApp =
Nothing
End
Sub |