Creating a link via VBA code

[WarrenB]

Firstly I apologise for posting this thread in Microsoft Access - General Discussion as well, I accidently posted on the wrong board.

Basically what I need to do is use VB code to create a link to a table in a remote database. Any help would be much appreciated. =================
Thankyou
Warren Brown
wazzer@btinternet.com
=================

 

[WarrenB]

oh also is it possible to call the location of the remote database from a field within a table? =================
Thankyou
Warren Brown
wazzer@btinternet.com
=================

 

[scking]

Here is a sample.


Steve King

Option Compare Database 'Use database order for string comparisons
Option Explicit

Public Sub CheckAttachedTableLinks()
On Error GoTo ErrorHandler

Dim dbCurrent As Database
Dim tblDefinition As TableDef
Dim rstAction_Officers As Recordset
Dim strDATA_FileName As String
Dim strDATA_FullPathName As String
Dim strErrorMessage As String
Dim blnReattachmentProgressMeterIsActive As Boolean
Dim intTableDefIndex As Integer
Dim intUserAnswer As Integer
Dim intNumberOfTablesReattached As Integer
Dim intNumberOfTablesToBeReattached As Integer
Dim varReturnValue As Variant

Const intNONEXISTENT_TABLE As Integer = 3011
Const intPPHCDATA_NOT_FOUND As Integer = 3024
Const intACCESS_DENIED As Integer = 3051
Const intREAD_ONLY_DATABASE As Integer = 3027

intNumberOfTablesReattached = 0
blnReattachmentProgressMeterIsActive = False
strDATA_FileName = "LogGenData.MDB"
strDATA_FullPathName = strDATA_FileName

Set dbCurrent = CurrentDb()
On Error Resume Next 'This must be here

Set rstAction_Officers = dbCurrent.OpenRecordset("tblUser_Descriptions&quot


If Err <> 0 Then
'Error encountered in trying to access the linked table tblAction_Officers
'Notify the user and allow him/her to find the missing database file using a Browse dialog box

MsgBox Prompt:=&quot;One or more of the linked tables cannot be accessed. &quot; _
& &quot;Please locate the &quot; & strDATA_FileName & &quot; file.&quot;, _
Buttons:=vbExclamation, _
Title:=strMessage_Title

Browse (strDATA_FullPathName)

intUserAnswer = vbRetry

Do While ((strDATA_FullPathName = &quot;&quot And (intUserAnswer = vbRetry))
'User cancelled or closed the Browse dialog box without selecting a file
'Notify user that application cannot be run without finding the IOCDATA.MDB file

strErrorMessage = &quot;You can't run the &quot; & strMessage_Title _
& &quot; until you locate the &quot; & strDATA_FileName _
& &quot; file. Choose Retry to try to find the file again;&quot; _
& &quot; choose Cancel to quit Microsoft Access.&quot;

intUserAnswer = MsgBox(Prompt:=strErrorMessage, _
Buttons:=vbRetryCancel, _
Title:=strMessage_Title)

If intUserAnswer = vbRetry Then
Browse (strDATA_FullPathName)
Else
'Terminate code execution, close files opened with the Open statement and clear variables.
DoCmd.Quit
End If 'If intUserAnswer = vbRetry Then

Loop 'Do While (IOCDATA_FullPathName = &quot;&quot And (UserWantsToTryAgain = True)

If strDATA_FullPathName <> &quot;&quot; Then
'User selected a file using the Browse dialog box

' For each table, check its connect property; if it's not connected, increment the number of
' tables to be reattached (for use with the reattachment progress meter)

intNumberOfTablesToBeReattached = 0

For intTableDefIndex = 0 To dbCurrent.TableDefs.count - 1
Set tblDefinition = dbCurrent.TableDefs(intTableDefIndex)
If tblDefinition.Connect <> &quot;&quot; Then
intNumberOfTablesToBeReattached = intNumberOfTablesToBeReattached + 1
End If 'If tblDefinition.Connect <> &quot;&quot; Then
Next intTableDefIndex 'For intTableDefIndex = 0 To dbCurrent.TableDefs.Count - 1

' Initialize the reattachment progress meter

varReturnValue = SysCmd(Action:=acSysCmdInitMeter, _
Argument2:=&quot;Attaching Tables&quot;, _
Argument3:=intNumberOfTablesToBeReattached)

blnReattachmentProgressMeterIsActive = True

' For each table, set its connect property appropriately, using the database file's full path name
' Next, refresh the table's link

intTableDefIndex = 0
Err = 0

While ((intTableDefIndex <= dbCurrent.TableDefs.count - 1) _
And _
(Err = 0))

Set tblDefinition = dbCurrent.TableDefs(intTableDefIndex)
If tblDefinition.Connect <> &quot;&quot; Then 'Skip base tables
tblDefinition.Connect = &quot;;DATABASE=&quot; & strDATA_FullPathName

Err = 0 ' If the RefreshLink operation is not successful, Err will become nonzero
tblDefinition.RefreshLink

End If 'If tblDefinition.Connect <> &quot;&quot; Then

If Err = 0 Then
' RefreshLink operation was successful for the current table
' Update the appropriate counters and press on

intNumberOfTablesReattached = intNumberOfTablesReattached + 1
varReturnValue = SysCmd(Action:=acSysCmdUpdateMeter, _
Argument2:=intNumberOfTablesReattached)

intTableDefIndex = intTableDefIndex + 1

End If 'If Err = 0 then

Wend 'While (TableDefIndex <= dbCurrent.TableDefs.Count - 1) And (Err = 0)

If Err <> 0 Then
'An error was encountered during the RefreshLink operation
'Notify the user with the appropriate message

If Err = intNONEXISTENT_TABLE Then
MsgBox Prompt:=&quot;The file '&quot; & strDATA_FullPathName & &quot;' does &quot; _
& &quot;not contain the table '&quot; & tblDefinition.Name _
& &quot;' required by the &quot; & strMessage_Title & &quot;.&quot;, _
Buttons:=vbCritical, _
Title:=strMessage_Title

ElseIf Err = intPPHCDATA_NOT_FOUND Then
MsgBox Prompt:=&quot;The &quot; & strMessage_Title & &quot; cannot be run until&quot; _
& &quot;the &quot; & strDATA_FileName & &quot; file is located.&quot;, _
Buttons:=vbCritical, _
Title:=strMessage_Title

ElseIf Err = intACCESS_DENIED Then
MsgBox Prompt:=&quot;Couldn't open &quot; & strDATA_FullPathName _
& &quot; because it is read-only or it is located on a &quot; _
& &quot;read-only share.&quot;, _
Buttons:=vbCritical, _
Title:=strMessage_Title

ElseIf Err = intREAD_ONLY_DATABASE Then
MsgBox Prompt:=&quot;Can't reattach tables because &quot; _
& strDATA_FullPathName & &quot; is read-only or is &quot; _
& &quot;located on a read-only share.&quot;, _
Buttons:=vbCritical, _
Title:=strMessage_Title
Else
MsgBox Prompt:=ERROR, _
Buttons:=vbCritical, _
Title:=strMessage_Title
End If

End 'Terminate code execution, close files opened with the Open statement
'and clear variables.
Else
' Err = 0, so all tables were successfully reattached
' Remove the reattachment progress meter from the status bar

varReturnValue = SysCmd(Action:=acSysCmdRemoveMeter)

End If 'If Err <> 0 Then (from attempt to refresh a table's link)

End If 'If IOCDATA_FullPathName <> &quot;&quot; then

End If 'If Err <> 0 Then (from attempt to open recordset with tblAirline_Information)

Exit Sub

ErrorHandler:

If blnReattachmentProgressMeterIsActive Then
varReturnValue = SysCmd(Action:=acSysCmdRemoveMeter)
End If 'If ReattachmentProgressMeterIsActive Then

Exit Sub
End Sub

Growth follows a healthy professional curiosity

 

[DougP]

This may be a tad simpler
Note you must &quot;check&quot; on Microsoft ADO 2.5 in &quot;Tools&quot; &quot;References&quot;

Dim Conn2 As ADODB.Connection
Dim Rs2 As ADODB.Recordset
Dim SQLCode As String
Set Conn2 =
Set Conn2 = &quot;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\foldername\database.mdb;&quot;
Set Rs2 = New ADODB.Recordset
SQLCode = &quot;Select * From [your table] Where yourfield = &quot; & Something & &quot;;&quot;
Rs2.Open SQLCode, Conn2, adOpenStatic, adLockReadOnly

Rs2.Movefirst
debug.print Rs2!yourfield

set RS2 = nothing
set Conn2 = nothing

DougP, MCP

Visit my WEB site

http://www.barcodeone.com

to see how Bar-codes can help you be more productive