|
2#
楼主 |
发表于 2005-11-17 19:05:00
|
只看该作者
用过以下代码,都不成功!!哪位高手能否帮我看看,最好一次解决"用VBA创建系统DSN"和"刷新MDB+SQL的链接"这两大问题!!代码1(刷新链接的)Dim db As Database
Dim tbl As TableDef
Set db = CurrentDb
For Each tbl In db.TableDefs
If tbl.Attributes = 536870912 Then
tbl.Connect = "DSN=gdts;UID=" & a & "WD=" & b & ";WSID=;DATABASE=" & d & ";Network=DBMSSOCN"
tbl.RefreshLinktbl.Attributes = dbAttachSavePWD
End If
Next代码2 (直接用VBA创建系统DSN)'*********************** Code Start ***************************
'
Const JDS_DSN_name = "MDTS" ' DSN的名字
Const JDS_Server_name = "148.154.61.15" ' 服务器名,这里给出的服务器的IP地址,
' 也可以通过域名解析给出域名 ' 定义注册表API函数
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _
Alias "RegEnumKeyExA" _
(ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
lpcbName As Long, _
ByVal lpReserved As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
ByVal lpftLastWriteTime As String) As LongPrivate Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As LongPrivate Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As LongConst HKEY_LOCAL_MACHINE = &H80000002Const ERROR_SUCCESS = 0&
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_READ = &H20000
Const STANDARD_RIGHTS_WRITE = &H20000
Const STANDARD_RIGHTS_EXECUTE = &H20000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_value = &H1
Const KEY_SET_value = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_value Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))Const REG_DWORD = 4
Const REG_BINARY = 3
Const REG_SZ = 1
Const ODBC_ADD_SYS_DSN = 4
Private Declare Function SQLConfigDataSource Lib "odbccp32.dll" _
(ByVal hwndParent As Long, _
ByVal fRequest As Integer, _
ByVal lpszDriver As String, _
ByVal lpszAttributes As String) As Long
Function Check_SDSN() ' 查看我们要的系统数据源(DSN)是否存在。
' 如果存在,正好;否则,我们就创建一个。
Dim lngKeyHandle As Long
Dim lngResult As Long
Dim lngCurIdx As Long
Dim strvalue As String
Dim classvalue As String
Dim timevalue As String
Dim lngvalueLen As Long
Dim classlngvalueLen As Long
Dim lngData As Long
Dim lngDataLen As Long
Dim strResult As String
Dim DSNfound As Long
Dim syscmdresult As Long syscmdresult = SysCmd(acSysCmdSetStatus, "查找系统DSN: " & JDS_DSN_name & " ...")
' 打开包含系统数据源(DSN)的注册表主键。
lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"SOFTWARE\ODBC\ODBC.INI", _
0&, _
KEY_READ, _
lngKeyHandle) If lngResult <> ERROR_SUCCESS Then
MsgBox "错误: 不能打开注册键 HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI." & _
vbCrLf & vbCrLf & _
"请安装SQL Server的ODBC驱动程序用以调用MDTS系统数据源。" & _
vbCrLf & _
"要获得更多的信息,请与管理员联系。"
syscmdresult = SysCmd(acSysCmdClearStatus)
Check_SDSN = -1
End If
' 现在这个注册键是打开的,我们在这个查找看是否我们需要的。 lngCurIdx = 0
DSNfound = False
Do
lngvalueLen = 512
|
|