代码自动创建ODBC源

tmtony

自动创建ODBC

1. 
   
2. Function gt_TestOdbc(rstDsn As String, rstrUser As String, rstrPassword As String, rstrTableName As String) As Boolean
   
3. On Error GoTo err_c
   
4. DoCmd.SetWarnings False
   
5. 
   
6. Dim Response As Integer
   
7. Dim connstr As String, mydb As DAO.Database
   
8. connstr = "ODBC;DSN=" & rstDsn & ";"
   
9. connstr = connstr & "UID=" & rstrUser & ";"
   
10. connstr = connstr & "PWD=" & rstrPassword & ";"
    
11. 
    
12. Dim dbs As DAO.Database
    
13. Dim qdf As DAO.QueryDef
    
14. '
    
15. ' Set dbs = CurrentDb()
    
16. ' Set qdf = dbs.CreateQueryDef("")
    
17. '
    
18. ' 'Replace <DSN> with the actual DSN that points to your SQL Server.
    
19. ' qdf.connect = connstr ' "ODBC;DSN=<DSN>;UID=" & strUserId & "WD=" & _
    
20. ' strPassword & ";DATABASE=pubs"
    
21. ' qdf.ReturnsRecords = False
    
22. '
    
23. ' 'Any SQL statement will work below.
    
24. ' qdf.SQL = "SELECT * FROM " & rstrTableName
    
25. ' qdf.Execute
    
26. '
    
27. '
    
28. 
    
29. Set mydb = DBEngine.Workspaces(0).OpenDatabase("", False, False, connstr)
    
30. ' curpos = 0
    
31. gt_TestOdbc = True
    
32. Exit Function
    
33. err_c:
    
34. 
    
35. gt_TestOdbc = False
    
36. ' MsgBox "数据库用户,口令错误,重新登录!", , "文具"
    
37. ' DoCmd.RunSQL "delete from tblOdbcCfg"
    
38. ' DoCmd.Quit
    
39. Exit Function
    
40. End Function

复制代码

tmtony

谢谢, 翻出以前的老本, 感觉可能大家也用得到,就发上来