Excel创建 Access数据库并写入数据（变量修改）

Excel创建 Access数据库并写入数据（变量修改）请教大师：我想将下面红色部分的代码都修改成变量，这样通用性就很强，请问如何修改。谢谢！

Excel创建 Access数据库，并将指定工作表sheet1中实有数据写入数据库c:\bb.mdb中
创建的数据库名称：c:\bb.mdb
数据库表名：kk

Sub fig2()
Set x = CreateObject("adodb.connection")
x.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
On Error Resume Next    '如果数据库存在则跳过

Dim Wjm As String
Wjm = "d:\zyg365.mdb"
Set y = CreateObject("adox.catalog") 'ADO没有提供创建Access数据库的功能,用adox
y.create ("provider=microsoft.jet.oledb.4.0;data source=c:\bb.mdb") '创建access数据库

Sql = "select * into kk in 'c:\bb.mdb' from [sheet1$]" '写入数据库,创建表名kk表,把sheet1内容输出到数据库

Set yy = x.Execute(Sql)
On Error GoTo 0
Sql = "select *  from  kk in 'c:\bb.mdb' " '读入数据库
Set yy = x.Execute(Sql)
Sheet1.[a10].CopyFromRecordset yy  '数据库内容在a10
End Sub

你试试看：
Sub fig2()
Dim tb1 as string
Dim tb2 as string
Dim db as string

Set x = CreateObject("adodb.connection")
x.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
On Error Resume Next    '如果数据库存在则跳过

Dim Wjm As String
Wjm = "d:\zyg365.mdb"
Tb1=" [sheet1$]"
Tb2="kk"
db="c:\bb.mdb"
Set y = CreateObject("adox.catalog") 'ADO没有提供创建Access数据库的功能,用adox
y.create ("provider=microsoft.jet.oledb.4.0;data source=" & db) '创建access数据库

Sql = "select * into " & tb2 & " in " & db & " from "& tb1 '写入数据库,创建表名kk表,把sheet1内容输出到数据库

Set yy = x.Execute(Sql)
On Error GoTo 0
Sql = "select *  from " & tb2 & " in " & db '读入数据库
Set yy = x.Execute(Sql)
Sheet1.[a10].CopyFromRecordset yy  '数据库内容在a10
End Sub

不过，你的编程有点乱

谢谢版主的帮助，你的代码我测试没有通过。

我改成下面代码后测试无问题了：

'Excel创建 Access数据库并写入数据(应用变量，通用性强)

'Excel创建 Access数据库，并将指定工作表sheet1中实有数据写入数据库c:\bb.mdb中
'创建的数据库名称：c:\bb.mdb
'数据库表名: kk

Sub Excel创建Access数据库并写入数据()
Dim tb1 As String
Dim tb2 As String
Dim Mdb As String

Set x = CreateObject("adodb.connection")
x.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
On Error Resume Next    '如果数据库存在则跳过

Dim Wjm As String

tb1 = " [" & Application.ActiveSheet.Name & "$]" '当前活动工作表名称
tb2 = "数据库表名" '创建的数据库表名
Mdb = "c:\bb.mdb" '创建的数据库名称及路径

Set y = CreateObject("adox.catalog") 'ADO没有提供创建Access数据库的功能,用adox
y.create ("provider=microsoft.jet.oledb.4.0;data source=" & Mdb) '创建access数据库

Sql = "select * into " & tb2 & " in '" & Mdb & "' from" & tb1 '写入数据库,创建表名kk表,把sheet1内容输出到数据库

Set yy = x.Execute(Sql)
On Error GoTo 0

End Sub

Sub Excel创建Access数据库并写入数据()
Dim tb1 As String
Dim tb2 As String
Dim Mdb As String
  Dim MyPath$
  MyPath = ThisWorkbook.Path & "\"
Set x = CreateObject("adodb.connection")
x.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
On Error Resume Next    '如果数据库存在则跳过

Dim Wjm As String

tb1 = " [" & Application.ActiveSheet.Name & "$]" '当前活动工作表名称
tb2 = "数据库表名" '创建的数据库表名

   

Mdb = MyPath & "bb.Mdb" '创建的数据库名称及路径


Set y = CreateObject("adox.catalog") 'ADO没有提供创建Access数据库的功能,用adox
y.create ("provider=microsoft.jet.oledb.4.0;data source=" & Mdb) '创建access数据库

Sql = "select * into " & tb2 & " in '" & Mdb & "' from" & tb1 '写入数据库,创建表名kk表,把sheet1内容输出到数据库

Set yy = x.Execute(Sql)
On Error GoTo 0

End Sub