Question

vb调用access数据库,并将查询内容写入excel表中

现在遇到三个问题，请高手帮忙解决
1、excel中工作表不够，最多只能建255个表，我现在需要建2000个表，如何建立新工作簿，继续往里面写数据
2、我第一次调用的查询是1对1的关系，现在需要再调用一个查询，并将数据写入excel表中，vb中如何实现
就帮忙解决第一个问题吧，给段代码，要求新建excel表为原有模板，且需重命名

Answer 1

如果你不着急等下周，我有一个用VBS调用Excel，通过ODBC调用Access数据的程序，有模板，模板中带程序，一次生成N张报表。

我的VBS代码,可以参考一下。Excel2003 只能有255个表，可以换Excel2007/2010，你的表数量取决于你的内存。
我的建议是，你把程序编好，需要哪个表临时生成一下，用完了删除。
'将以下文字保存为 VBS 文件
'这段程序可以放到Word的模块中进行调试。

CreateReport

Sub CreateReport()
On Error Resume Next
KillExcel

Set vCnn = CreateObject("ADODB.Connection")
Set vrs = CreateObject("ADODB.Recordset")

Set xlApp = CreateObject("Excel.Application")
Set xlBook = CreateObject("Excel.Workbook")
xlApp.Visible = True

Dim Temp
Temp = "D:\报表AUTO.xlt" '模板文件
Path = "D:\XX\" '保存的文件路径

Dim Sql
vCnn.Open constr
Sql = "SELECT * FROM Table " '数据库查询语句

'Debug.Print Sql

Set vrs = vCnn.Execute(Sql)

'这部分是我的原始代码
vrs.MoveFirst

'循环生成所需要的文件
While Not vrs.EOF
product = vrs.Fields(0)
grade = vrs.Fields(1)

Set xlBook = xlApp.Workbooks.Add(Temp)

'运行模板中已经存在宏，看你是否需要,这一句可以改成将你提取的数据直接写入你需要的表中。
'我的模板中有自动保存的代码，你的模板如果没有宏的话需要在VBS中保存文件。
xlBook.Application.Run "CreateSheet", product, grade, PATH
xlApp.ActiveWorkbook.Close

vrs.MoveNext
Wend

xlApp.Quit

vrs.Close
vCnn.Close
'VBS 无法自动关闭Excel进程，需要Terminate掉。
KillExcel
End Sub

Sub KillExcel()'为了防止出错,自动终结所有Excel进程.
Dim y, x
Set y = GetObject("winmgmts:\\.\root\cimv2")
Set x = y.execquery("select * from win32_process where name='Excel.exe'")

For Each i In x
i.Terminate
Next
End Sub

Answer 2

问题1：
1.在往excel表中写数据的方法里判断当前表数，如果大于255了，新建一个excel文件，命名规则自己定
2.在新建文件后，打开该文件。继续读取你取到的记录集，然后将数据写入到新建的excel中。
新建文件和打开文件的相关代码百度下有很多,
注：新建文件的方法要放在记录集的loop中，这样才会使数据连续的读出
问题2.不好意思，没看懂你想要做什么。

Answer 3

创建新的工作表
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Set xlapp = CreateObject("excel.application")
Set xlbook = xlapp.Workbooks.Add
xlbook.Saveas "c:\aaa.xls"'你要保存的文件路径
xlapp.Visible = True '设置EXCEL对象可见（或不可见）
Set xlsheet = xlbook.Worksheets(1) '设置活动工作表
xlsheet.Cells(1, 1) = "aa" '给单元格（row,col）赋值
xlsheet.Cells(1, 2) = "bb"
xlbook.Close (True) '关闭工作簿
xlapp.Quit '结束EXCEL对象
Set xlapp = Nothing '释放xlApp对象

第二个问题没眼拙看懂