access 能够实现这个效果

cekous

NA.rar (13.88 KB, 下载次数: 16)

2011-8-26 10:29 上传

点击文件名下载附件

姓名	销量
张珊	1
张珊	2
李四	13
李四	23

我有一张ACCESS的Query1 ，如上表所示
通过怎么操作可以达到如下效果？

姓名	销量
张珊	1
张珊	2

导出到excel ，文件命名为 张珊.xls

姓名	销量
李四	13
李四	23

导出到另一个excel ，文件命名为 张珊.xls

zhangjimfu

一次性导出多个文件,需要用VBA了

zhangjimfu

1. Sub test()
   
2.    
   
3.     DoCmd.OutputTo acOutputQuery, "Query1", "*.xls", "F:\门店会计工作规划\Test.xls"
   
4.    
   
5. End Sub

复制代码

cekous

zhangjimfu 发表于 2011-8-26 13:20

姓名        销量
张珊        1
张珊        2
李四        13
李四        23

只能导出到一个文件里面

zhangjimfu

1. Sub OutputExcel(FileName As String)
   
2.     Dim myPath$, pathFile$
   
3.     myPath = CurrentDb.Name
   
4.     pathFile = Left(myPath, VBA.InStrRev(myPath, "")) & FileName & ".xls"
   
5.     DoCmd.OutputTo acOutputQuery, "Query2", "*.xls", pathFile
   
6. End Sub
   
7. 
   
8. Sub qryTest(PersonnelName As String)
   
9.     Dim dbs As Database, sql$
   
10.     sql = "Select * From NA Where 姓名='" & PersonnelName & "'"
    
11.     Set dbs = CurrentDb
    
12.     dbs.QueryDefs("Query2").sql = sql
    
13.     dbs.Close
    
14. End Sub
    
15. 
    
16. Sub OutputMain()
    
17.     Dim cnn, rst, sql$
    
18.     Set cnn = CreateObject("ADODB.Connection")
    
19.     Set rst = CreateObject("ADODB.Recordset")
    
20.     cnn.Open "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & CurrentDb.Name
    
21.     sql = "Select distinct 姓名 From NA"
    
22.     Set rst = cnn.Execute(sql)
    
23.     While Not rst.EOF
    
24.         Call qryTest(rst("姓名").Value)
    
25.         Call OutputExcel(rst("姓名").Value)
    
26.         rst.MoveNext
    
27.     Wend
    
28.     cnn.Close
    
29.     Set cnn = Nothing
    
30.     Set rst = Nothing
    
31. End Sub

复制代码

NA.rar (25.18 KB, 下载次数: 21)

2011-8-26 15:54 上传

点击文件名下载附件

详见附件!

cekous

zhangjimfu 发表于 2011-8-26 15:54
详见附件!

谢谢！真厉害就是感觉有点像EXCEL 写出来的VBA了～

要是能够简化就好了～
Set cnn=CreateObject 这种东西去掉就好了

我看到有人实现用field(0)的方式实现 导出第一列数据

zhangjimfu

像什么并不重要,重要的是能解决问题啊,呵呵....
方法肯定还有多种,我也同样期待高手的解答

cekous

zhangjimfu 发表于 2011-8-26 16:11
像什么并不重要,重要的是能解决问题啊,呵呵....
方法肯定还有多种,我也同样期待高手的解答

在UMV平台中，我们除了可以用平台自带的功能实现把查找到的数据导出到EXCEL中外，我们也可以建一查询窗体，添加一命令按钮，在CLICK事件中，加入下列代码，实现导出功能。

Private Sub cmd导出_Click()
'这里将使用DAO来改变查询的SQL语句，必须先在“工具”→“引用”中选择
'Microsoft DAO 3.6 Object Library.
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    Dim qdf As DAO.QueryDef    'qdf被定义为一个查询定义对象
    Dim strWhere, strSQL As String
    strWhere = Me.ChildForm.Form.Filter
    If strWhere = "" Then    '没有条件
        strSQL = "Select * FROM qryCgmxData"    '根据实际情况修改
    Else    '有条件
        strSQL = "Select * FROM qryCgmxData where " & strWhere
    End If
    Set qdf = CurrentDb.QueryDefs("qryXlsData")
    qdf.sql = strSQL
    qdf.Close
    Set qdf = Nothing
    DoCmd.OutputTo acOutputQuery, "qryXlsData", acFormatXLS, , True
End Sub

注意事项：

1、必须事先在系统中添加一名称为“qryXlsData"的查询，内容不限。

2、上面代码中的strSQL根据实际情况自定义。

zhangjimfu

cekous 发表于 2011-8-26 16:11
在UMV平台中，我们除了可以用平台自带的功能实现把查找到的数据导出到EXCEL中外，我们也可以建一查询窗体 ...

如果用窗体导出,那就省事多了

cekous

你会做窗口导出？教教我！我也在研究中。