|
Option
Explicit
'© 2004
Alla rättigheter XL-Dennis
Private
cnt
As
ADODB.Connection
Private
rst
As
ADODB.Recordset
'Konstanta sträng-värden
Const
stCon
As String
=
"Provider=SQLOLEDB.1;"
&
_
"Integrated Security=SSPI;"
&
_
"Persist Security Info=False;"
&
_
"User ID=sa;"
&
_
"Initial Catalog=Northwind;"
&
_
"Data Source = DENWAL"
Const
stSQL1
As String
=
"SELECT FirstName,LastName FROM Employees ORDER BY LastName"
Const
stSQL2
As String
=
"SELECT DISTINCT ShipCity FROM Orders WHERE ShipCity LIKE 'M%'"
_
&
" ORDER BY ShipCity"
Private Sub
cmbCancel_Click()
'Om
användaren väljer att stänga programmet.
Unload
Me
End Sub
Private Sub
cmbExport_Excel_Click()
Dim
stSQL
As String,
stName
As String,
stLName
As String,
stFName
As String
Const
Separator
As String
=
","
Dim
xlApp
As
Excel.Application
Dim
xlwbBook
As
Excel.Workbook
Dim
xlwsSheet
As
Excel.Worksheet
Dim
xlRange
As
Excel.Range
'Kontroll att värden har valts i båda combobox-objekten.
With Me
If
.Combo1.ListIndex = -1
Then
.Combo1.SetFocus
MsgBox
"En
anställd måste väljas.",
vbCritical
ElseIf
.Combo2.ListIndex = -1
Then
.Combo2.SetFocus
MsgBox
"En skeppningshamn måste väljas.",
vbCritical
End If
End
With
'Här
delas den anställdes namn upp i två delar, för- och efternamn.
'Funktionen Split kan användas istället om så önskas.
stName = Me.Combo1.Text
stLName =
Mid(stName,
1,
InStr(1,
stName, Separator) -
1)
stFName
=
Right(stName,
Len(stName)
- (InStr(1,
stName, Separator) +
1))
'SQL-uttrycket med en subquery.
stSQL =
"SELECT SUM(Freight) FROM Orders"
_
&
" WHERE ShipCity = '"
&
Me.Combo2.Text
&
"'"
_
&
" AND EmployeeID = (SELECT EmployeeID FROM Employees"
_
&
" WHERE Lastname='"
&
stLName
&
"'"
_
&
" AND Firstname ='"
&
stFName
&
"')"
Set
cnt =
New
ADODB.Connection
Set
rst =
New
ADODB.Recordset
cnt.Open stCon
With
rst
.CursorLocation = adUseClient
.Open stSQL, cnt
Set
.ActiveConnection =
Nothing
End With
'Kontroll om posten innehåller ett värde eller ett sk Null-värde.
If IsNull(rst(0).Value)
=
True Then
MsgBox
"Ingen matchande post hittades!",
vbInformation
GoTo
ExitHere
End If
Set
xlApp =
New
Excel.Application
'Skapar
en ny arbetsbok med endast ett arbetsblad.
Set
xlwbBook = xlApp.Workbooks.Add(xlWBATWorksheet)
Set
xlwsSheet = xlwbBook.Worksheets(1)
Set
xlRange = xlwsSheet.Range("A2")
'Transfererar det erhållna värdet.
xlRange.CopyFromRecordset rst
'Visar arbetsboken och aktiverar Excel-instansen.
With
xlApp
.Visible =
True
.UserControl =
True
End With
'Städar upp och frigör arbetsminne.
ExitHere:
rst.Close
Set
rst =
Nothing
cnt.Close
Set
cnt =
Nothing
Set
xlRange =
Nothing
Set
xlwsSheet =
Nothing
Set
xlwbBook =
Nothing
Set
xlApp =
Nothing
End Sub
Private Sub
Form_Load()
Set
cnt =
New
ADODB.Connection
Set
rst =
New
ADODB.Recordset
Dim
i
As Long
cnt.Open stCon
With
rst
.CursorLocation = adUseClient
.Open stSQL1, cnt
Set
.ActiveConnection =
Nothing
End With
'Läser in listvärden till combobox-objektet för anställda.
With
Me.Combo1
.Clear
Do Until
rst.EOF
.AddItem rst(1).Value
&
", "
&
rst(0).Value
rst.MoveNext
Loop
.ListIndex = -1
End With
'Stänger recordset.
rst.Close
With
rst
.CursorLocation = adUseClient
.Open stSQL2, cnt
Set
.ActiveConnection =
Nothing
End With
'Läser in listvärden till combobox-objektet för skeppninghamnar.
With
Me.Combo2
.Clear
Do Until
rst.EOF
.AddItem rst(0).Value
rst.MoveNext
Loop
.ListIndex
= -1
End With
'Stänger anslutningen och frigör arbetsminne.
rst.Close
Set
rst =
Nothing
cnt.Close
Set
cnt =
Nothing
End Sub
|
