如何在Access里生成导出多个Excel文件，请大家帮帮忙
表1
部门姓名业务量1业务量2业务量3
部门A小张3233560972264
部门B小李934826341650
部门A小王1531435862604
部门C小吴1041623932174
部门A小赵1042332211247
部门D小钱76462081616
部门A小孙3175361281407
部门B小田165053805672
如何按部门查询后，生成部门A.xls,B.xls等等，
我用select 表1.部门，* into [Excel 8.0;database=d:\部门A.xls].sheets1
from 表1
where (((表1.部门）= "部门A "));
这样每次只能产生一个xls，如何才能产生多个Excel表。请大家指点一二，感激不尽。
最好产生的excel表中，分别以姓名为表名，而不仅仅是都导出到sheets1里。
[解决办法]
Public Sub ExportToExcel()
Dim strSQL As String
Dim Cnn As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim strPathAndFullName As String
Set Cnn = CurrentProject.Connection
'先删除可能已经存在的同名xls文件
strSQL = "select 部门 from 表1 group by 部门 "
Rst.Open strSQL, Cnn, adOpenKeyset, adLockOptimistic
If Not Rst.EOF Then
Rst.MoveFirst
Do While Not Rst.EOF
strPathAndFullName = "D:\ " & Rst!部门 & ".xls "
If Dir(strPathAndFullName) <> " " Then
Kill strPathAndFullName
End If
Rst.MoveNext
Loop
End If
Set Rst = Nothing
'开始生成xls文件，相同部门的生成在一个xls中，不同的姓名生成在不同的sheet中
strSQL = "select 部门,姓名 from 表1 group by 部门,姓名 "
Rst.Open strSQL, Cnn, adOpenKeyset, adLockOptimistic
If Not Rst.EOF Then
Rst.MoveFirst
Do While Not Rst.EOF
strSQL = "select 部门,* into [Excel 8.0;database=d:\ " & Rst!部门 & ".xls]. " & Rst!姓名 & " " _
& " from 表1 " _
& " where 部门= ' " & Rst!部门 & " ' and 姓名= ' " & Rst!姓名 & " ' "
Cnn.Execute strSQL
Rst.MoveNext
Loop
End If
End Sub
[解决办法]
OR
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset( "select 部门,姓名 from tt6 group by 部门,姓名 ")
Do While Not rs.EOF
qw = "select 部门,* into [Excel 8.0;database=d:\TEMP\ " & rs( "部门 ") & ".xls]. " & rs( "姓名 ") & " from tt6 where 部门= ' " & rs( "部门 ") & " ' and 姓名= ' " & rs( "姓名 ") & " ' "
CurrentDb.Execute qw
rs.MoveNext
Loop
