- 帖子
- 37
- 主題
- 29
- 精華
- 0
- 積分
- 70
- 點名
- 6
- 作業系統
- win10
- 軟體版本
- excel 2010
- 閱讀權限
- 20
- 註冊時間
- 2025-1-7
- 最後登錄
- 2025-1-23
|
3#
發表於 2025-1-17 16:10
| 只看該作者
以前在網上看到的~~
Function AttachDSNLessTableSQLServer(stLocalTableName As String, _
stRemoteTableName As String, _
stServer As String, _
stDatabase As String, _
Optional stUsername As String, _
Optional stPassword As String, _
Optional strKey As String, _
Optional strDescription As String = "")
' stLocalTableName 本地資料表名稱
' stRemoteTableName 伺服器資料表名稱
' stServer 伺服器名稱或IP
' stDatabase 資料庫名稱
' stUsername 使用者名稱
' stPassword 使用者密碼
' strKey 索引套用欄位
' strDescription 資料表描述
On Error GoTo AttachDSNLessTableSQLServer_Err
Dim td As TableDef
Dim stConnect As String
CurrentDb.TableDefs.Delete stLocalTableName
If Len(stUsername) = 0 Then
'//Use trusted authentication if stUsername is not supplied.
stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes"
Else
'//WARNING: This will save the username and the password with the linked table information.
stConnect = "ODBC;DRIVER=SQL Server;SERVER={" & stServer & "};DATABASE=" & stDatabase & ";UID=" & stUsername & ";PWD=" & stPassword
End If
Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, stConnect)
CurrentDb.TableDefs.Append td
'建立索引
If Len(strKey) > 0 Then
DoCmd.RunSQL "CREATE UNIQUE INDEX UniqueIndex ON [" & stLocalTableName & "] (" & strKey & ")"
End If
'建立描述
If strDescription <> "" Then
Set prp = CurrentDb.TableDefs(stLocalTableName).CreateProperty("Description", dbText, strDescription)
CurrentDb.TableDefs(stLocalTableName).Properties.Append prp
End If
AttachDSNLessTableSQLServer = True
Exit Function
AttachDSNLessTableSQLServer_Err:
If err.Number = 3265 Then
'刪除連結資料表時，資料表不存在
Resume Next
Else
AttachDSNLessTableSQLServer = False
MsgBox "AttachDSNLessTableSQLServer encountered an unexpected error: " & err.Description
End If
End Function |
|
