[已解决]跪求两段SQL代码...........

ampa

我想通过vba代码，用附件中的原表.xls里的数据创建一个access数据库data.mdb，并为该数据库添加可读写的用户名admin，密码1234。
然后另外一段代码可以把“添加新数据.xls”的数据添加到该数据库。
请问各位大哥老师，这个可以通过vba代码实现吗？该怎么做啊
谢谢

最佳答案

月排行榜 / 总排行榜

wcymiss

2013-1-11 13:06

1. Sub 创建()
   
2.     Dim Sql As String, mdbNa As String, mdbStr As String
   
3.     Dim xlsNa As String, xlsStr As String, Pw As String
   
4.     Dim Ca As Object, Cnn As Object
   
5. 
   
6.     Set Ca = CreateObject("adox.catalog")
   
7.     Set Cnn = CreateObject("adodb.connection")
   
8.     Pw = "1234"
   
9.     mdbNa = ThisWorkbook.Path & "\data.mdb"
   
10.     xlsNa = ThisWorkbook.Path & "\原表.xls"
    
11.     mdbStr = "Provider=Microsoft.jet.OLEDB.4.0;Jet OLEDB:Database password=" & Pw & ";Data Source="
    
12.     xlsStr = "[excel 8.0;database=" & xlsNa & "].[data$]"
    
13.    
    
14.     If Len(Dir(mdbNa)) Then '如果表已存在则删除
    
15.         Kill mdbNa
    
16.     End If
    
17.    
    
18.     Ca.Create mdbStr & mdbNa
    
19.     Cnn.Open mdbStr & mdbNa
    
20.     Sql = "select * into [data] from " & xlsStr
    
21.     Cnn.Execute (Sql)
    
22.    
    
23.     Ca.ActiveConnection.Close
    
24.     Cnn.Close
    
25.     Set Cnn = Nothing
    
26.     Set Ca = Nothing
    
27. End Sub

复制代码

1. Sub 添加()
   
2.     Dim Sql As String, mdbNa As String, mdbStr As String
   
3.     Dim xlsNa As String, xlsStr As String, Pw As String
   
4.     Dim Cnn As Object
   
5.    
   
6.     Set Cnn = CreateObject("adodb.connection")
   
7.     Pw = "1234"
   
8.     mdbNa = ThisWorkbook.Path & "\data.mdb"
   
9.     xlsNa = ThisWorkbook.Path & "\添加新数据.xls"
   
10.     mdbStr = "Provider=Microsoft.jet.OLEDB.4.0;Jet OLEDB:Database password=" & Pw & ";Data Source="
    
11.     xlsStr = "[excel 8.0;database=" & xlsNa & "].[Sheet1$]"
    
12.    
    
13.     Cnn.Open mdbStr & mdbNa
    
14.     Sql = "insert into [data] select * from " & xlsStr
    
15.     Cnn.Execute (Sql)
    
16.    
    
17.     Cnn.Close
    
18.     Set Cnn = Nothing
    
19. End Sub

复制代码

跳转到最佳答案楼层

ampa

有没有老师会这个啊...........

wcymiss

1. Sub 创建()
   
2.     Dim Sql As String, mdbNa As String, mdbStr As String
   
3.     Dim xlsNa As String, xlsStr As String, Pw As String
   
4.     Dim Ca As Object, Cnn As Object
   
5. 
   
6.     Set Ca = CreateObject("adox.catalog")
   
7.     Set Cnn = CreateObject("adodb.connection")
   
8.     Pw = "1234"
   
9.     mdbNa = ThisWorkbook.Path & "\data.mdb"
   
10.     xlsNa = ThisWorkbook.Path & "\原表.xls"
    
11.     mdbStr = "Provider=Microsoft.jet.OLEDB.4.0;Jet OLEDB:Database password=" & Pw & ";Data Source="
    
12.     xlsStr = "[excel 8.0;database=" & xlsNa & "].[data$]"
    
13.    
    
14.     If Len(Dir(mdbNa)) Then '如果表已存在则删除
    
15.         Kill mdbNa
    
16.     End If
    
17.    
    
18.     Ca.Create mdbStr & mdbNa
    
19.     Cnn.Open mdbStr & mdbNa
    
20.     Sql = "select * into [data] from " & xlsStr
    
21.     Cnn.Execute (Sql)
    
22.    
    
23.     Ca.ActiveConnection.Close
    
24.     Cnn.Close
    
25.     Set Cnn = Nothing
    
26.     Set Ca = Nothing
    
27. End Sub

复制代码

1. Sub 添加()
   
2.     Dim Sql As String, mdbNa As String, mdbStr As String
   
3.     Dim xlsNa As String, xlsStr As String, Pw As String
   
4.     Dim Cnn As Object
   
5.    
   
6.     Set Cnn = CreateObject("adodb.connection")
   
7.     Pw = "1234"
   
8.     mdbNa = ThisWorkbook.Path & "\data.mdb"
   
9.     xlsNa = ThisWorkbook.Path & "\添加新数据.xls"
   
10.     mdbStr = "Provider=Microsoft.jet.OLEDB.4.0;Jet OLEDB:Database password=" & Pw & ";Data Source="
    
11.     xlsStr = "[excel 8.0;database=" & xlsNa & "].[Sheet1$]"
    
12.    
    
13.     Cnn.Open mdbStr & mdbNa
    
14.     Sql = "insert into [data] select * from " & xlsStr
    
15.     Cnn.Execute (Sql)
    
16.    
    
17.     Cnn.Close
    
18.     Set Cnn = Nothing
    
19. End Sub

复制代码