Dzwebs.Net

撰写电脑技术杂文十余年

VBA如何刷新链接表

Admin | 2013-5-28 9:58:29 | 被阅次数 | 8206

温馨提示!

如果未能解决您的问题,请点击搜索;登陆可复制文章,点击登陆

  如下的代码,是和数据库有关的VBA代码。下面是示例。

  Err = 0
  On Error Resume Next

  Dim wrkODBC As Workspace
  Dim conPubs As Connection
  Dim mydb As Database, mytable As TableDef
  Dim I As Integer, j As Integer
  Dim connectstr As String

  DoCmd.Hourglass True
  DoCmd.SetWarnings False

  Set mydb = DBEngine.Workspaces(0).Databases(0)

  Dim passdb As String, ww As Integer
  Dim f As Integer, g As Integer
  passdb="pass"
  connectstr = "ODBC;DSN=" & Me.dsn & ";"
  connectstr = connectstr & "UID=" & Me.dbuser_id & ";"
  connectstr = connectstr & "PWD=" & passdb & ";"
  'connectstr = connectstr & "PWD=" & Me.dbpass_id & ";"

  Set wrkODBC = CreateWorkspace("NewODBCWorkspace", "", "", dbUseODBC)
  Set conPubs = wrkODBC.OpenConnection("sam_user", dbDriverNoPrompt, , connectstr)
  If Err <> 0 Then GoTo dbuser_sam_err

  On Error GoTo dbuser_conn_err

  I = mydb.TableDefs.count 'tables count
  For j = 0 To I - 1
  Set mytable = mydb.TableDefs(j)
  If mytable.Attributes = DB_ATTACHEDODBC or mytable.Attributes = DB_ATTACHEDODBC + DB_ATTACHSAVEPWD Then
  mytable.connect = connectstr
  mytable.RefreshLink
  End If
  Next
  On Error Resume Next

  DoCmd.Hourglass False
  MsgBox "数据表链接完成!", , "提示"
  Err = 0
  Exit Sub

  dbuser_sam_err:
  DoCmd.Hourglass False
  MsgBox "用户名和密码错误,重新登录!", , "提示"
  Err = 0
  Exit Sub

  dbuser_conn_err:
  DoCmd.Hourglass False
  MsgBox Error$(Err), 16, "提示"
  Err = 0
  Exit Sub


该杂文来自: 数据库Sql,VFP,Access

上一篇:access设置主键

下一篇:Sql Group by分组语法实例

网站备案号:

网站备案号:滇ICP备11001339号-7

版权属性:

Copyright 2007-2021-forever Inc. all Rights Reserved.

联系方式:

Email:dzwebs@126.com QQ:83539231 访问统计