怎么在Access里生成导出多个Excel文件，请大家帮帮忙
如何在Access里生成导出多个Excel文件，请大家帮帮忙
表1
部门 姓名 业务量1 业务量2 业务量3
部门A 小张 32335 6097 2264
部门B 小李 9348 2634 1650
部门A 小王 15314 3586 2604
部门C 小吴 10416 2393 2174
部门A 小赵 10423 3221 1247
部门D 小钱 7646 2081 616
部门A 小孙 31753 6128 1407
部门B 小田 16505 3805 672
如何按部门查询后，生成部门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
表1
部门 姓名 业务量1 业务量2 业务量3
部门A 小张 32335 6097 2264
部门B 小李 9348 2634 1650
部门A 小王 15314 3586 2604
部门C 小吴 10416 2393 2174
部门A 小赵 10423 3221 1247
部门D 小钱 7646 2081 616
部门A 小孙 31753 6128 1407
部门B 小田 16505 3805 672
如何按部门查询后，生成部门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