求导出按钮编码

Henry D. Sy

1.     Dim rs As New ADODB.Recordset
   
2.     Dim strSQL As String, SQL As String
   
3.     Dim strOrigin() As String
   
4.     Dim I As Integer, J As Integer, K As Integer
   
5.     Dim strTableName As String
   
6. 
   
7.     strSQL = "select distinct 籍贯 from 档案"
   
8.     rs.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
   
9.     I = rs.RecordCount - 1
   
10.     ReDim strOrigin(I) As String
    
11.     For J = 0 To I
    
12.         strOrigin(J) = rs.Fields(0)
    
13.         rs.MoveNext
    
14.     Next
    
15.     rs.Close
    
16.     Set rs = Nothing
    
17. 
    
18.     For K = 0 To UBound(strOrigin)
    
19.         strTableName = strOrigin(K)
    
20.         SQL = "select *  into " & strTableName & " from 档案 where 籍贯='" & strOrigin(K) & "'"
    
21.         CurrentDb.Execute SQL
    
22.         DoCmd.OutputTo acOutputTable, strTableName, acFormatXLS, CurrentProject.Path & "" & strTableName & ".xls"
    
23.         DoCmd.DeleteObject acTable, strTableName
    
24.     Next

复制代码

[ 本帖最后由 Henry D. Sy 于 2008-12-6 00:00 编辑 ]

Henry D. Sy

, CurrentProject.Path & "\" & strTableName & ".xls"
把上面这句去掉

Henry D. Sy

你要说清楚，你的标题是不同的工作簿，
已在accessbbs帮你解决了。