2024年6月21日发(作者：)

VBA创建查询并批量导出excel

VBA代码:’ 新建一个查询，根据查询条件把access数据批量导出为N个Excel文

件Sub accessTOexcel()

Dim strsql As String

Dim qry As ef

Set qry = efs('导出查询')

Dim rst As New set

strsql = 'Select DISTINCT 供应商 FROM 采购价格'

strsql, tion, adOpenKeyset, adLockOptimistic

rst

Do Until

= rst(0)

= 'select 商品名称,供应商 from 采购价格 where 供应商='' &

rst(0) & '''

If Len(Dir( & '' & & '.xls'))

> 0 Then Kill & '' & & '.xls'

erSpreadsheet acExport, acSpreadsheetTypeExcel9,

, & '' & & '.xls', True

xt

Loop

= '导出查询'

End SubSub 新建查询()

Dim SQL0 As String

SQL0 = 'select * from 采购价格 where 1<>1'

If SQL0 <> '' Then

CreateQuery SQL0, '导出查询'

hDatabaseWindow

End If

End Sub

Private Sub CreateQuery(ByVal ssql As String, QueryName As String)

Dim Qdef As QueryDef

On Error Resume Next

If DCount('*', 'MSysObjects', 'Type=5 and Name='' & QueryName &

''') = 0 Then

Set Qdef = QueryDef(QueryName)

Else

Set Qdef = efs(QueryName)

End If

= ssql

Set Qdef = Nothing

End SubSub 删除查询()

On Error Resume Next

Object acQuery, '导出查询'

hDatabaseWindow

End Sub

Public Function QueryExists(strQueryName As String) As Boolean

Dim accQry As AccessObject

QueryExists = False

For Each accQry In ries

If strQueryName = Then

QueryExists = True

Exit For

End If

Next accQry

End Function