Help with ODBC Connection

[jpiscit1]

Hello everyone.

I relatively new to MS Access and ODBC connectivity. I developed a MS Access interface that is used to connect to our SQL server systems. All of the tables are Linked tables (to the SQL Server). Here is my problem:

Sometimes when I make a change to something on the SQL system (such as deleting a column in a table or modifying security) it screws up the ODBC connection at the Access database. The only way to get things working again is to go to each PC that is running the Access Database (the actual database file (mdb) is on a network drive) and modifying the local ODBC (DSN) connections. Actually its not really being modified, i think its just being re-initialized because all I do is click configure and Next, next, next , etc. in the DSN GUI. Is there some way to avoid this? Can you reference DSN connections somewhere in Access or a file so that it does not rely on the OS DSN? In other words, you would be able to connect and use the Access DB from any machine on the network as long as you had the right SQL security....

Thanks,

John


Your limits are only as far as you set your boundries......

 

[hwkranger]

Just refresh your tables. You can make it so your database automatically refreshes the tables on start up. Or you could have them

goto TOOLS: LINKED TABLE MANAGER

SELECT ALL, CLICK OK

But the answer to your question is: no

Randall Vollen
National City Bank Corp.

 

[jpiscit1]

Im familiar with the linked table manager tools. But I am more interested in how I can refresh my tables on start up ? Can you instruct me on how to proceed with that ?

Thanks

John

Your limits are only as far as you set your boundries......

 

[hwkranger]

I have it, but.. i don't know if you really want me to copy and paste all of it here:

But here goes:

Option Compare Database
Option Explicit

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert (Sybex)
' Copyright 1999. All rights reserved.

' =================================================
' The code in this module is dependent on two other
' modules: the standard module basFileOpen and
' the class module CommonDialog.
' =================================================

' =================================================
' The procedures in this module have been
' coded to work using either ADO or DAO.
' By default, they use ADO (USEDAO = False).
' To change to use DAO, set the USEDAO
' compiler constant to True.
' To use DAO, you must set a reference
' to the DAO typelib.
' To use ADO, you must set references to
' both the ADO and ADOX typelibs.
#Const USEDAO = False
' =================================================

Private Function CheckLink(strTable As String) As Boolean

' Checks the Link for the named table.
' (Actually, CheckLink also returns False if
' table doesn't exist.)
'
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert (Sybex)
' Copyright 1999. All rights reserved.
'
' In:
' strTable - table to check
' Out:
' Return Value - True if successful; False otherwise

On Error Resume Next

#If USEDAO Then
Dim varRet As Variant

' Check for failure. If can't determine the name of
' the first field in the table, link must be bad.
varRet = CurrentDb.TableDefs(strTable).Fields(0).Name
If Err.Number <> 0 Then
CheckLink = False
Else
CheckLink = True
End If
#Else
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset

Set cnn = CurrentProject.Connection
' Use OpenSchema to fill a recordset with information
' about the columns in strTable. If the recordset is
' empty then Jet couldn't connect so link must be bad.
Set rst = cnn.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, strTable, Empty))
CheckLink = Not rst.EOF

rst.Close
Set rst = Nothing
Set cnn = Nothing
#End If

End Function

#If USEDAO Then
Private Function adhCurrentDBPath() As String

' Return just the path of the current database,
' including the trailing backslash.

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert (Sybex)
' Copyright 1999. All rights reserved.

' NOTE: This is only useful if you're using DAO.
' If you're using ADO, use the CurrentProject.Path
' property instead.

On Error GoTo HandleErrors

Dim intPos As Integer
Dim strFullPath As String

strFullPath = CurrentDb.Name
' Find the last "\" in the file name.
intPos = InStrRev(strFullPath, "\")

' Given the position of the final "\",
' pull of the path portion.
If intPos > 0 Then
adhCurrentDBPath = Left$(strFullPath, intPos)
Else
adhCurrentDBPath = strFullPath
End If

ExitHere:
Exit Function

HandleErrors:
Select Case Err.Number
Case Else
Err.Raise Err.Number, Err.Source, _
Err.Description, Err.HelpFile, Err.HelpContext
End Select
Resume ExitHere
End Function
#End If

Function adhVerifyLinks(strDataDatabase As String, _
strSampleTable As String) As Boolean

' Check status of Links and attempt to fix if broken.
' If broken, first try the current database directory.
' If that fails, present user with file open dialog.
' Assumption: all links are to same back-end MDB file.
'
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All Rights Reserved.
'
' In:
' strDataDatabase - Name of backend data database
' strSampleTable - Name of a linked table to check
' Out:
' Return Value - True if successful; False otherwise

On Error GoTo adhVerifyLinksErr

Dim varReturn As Variant
Dim strDBDir As String
Dim strMsg As String
Dim varFileName As Variant
Dim intI As Integer
Dim intNumTables As Integer
Dim strProcName As String
Dim strFilter As String
Dim lngFlags As Long
#If USEDAO Then
Dim db As DAO.Database
Dim tdf As DAO.TableDef
#Else
Dim cnn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
#End If

strProcName = "adhVerifyLinks"

' Verify Links using one sample table.
varReturn = CheckLink(strSampleTable)

If varReturn Then
adhVerifyLinks = True
GoTo adhVerifyLinksDone
End If

#If USEDAO Then
' Get name of folder where application database
' is located.
strDBDir = adhCurrentDBPath()
#Else
strDBDir = CurrentProject.Path & "\"
#End If

If (Dir$(strDBDir & strDataDatabase) <> "") Then
' Data database found in current directory.
varFileName = strDBDir & strDataDatabase
Else
' Let user find data database using common dialog.
strMsg = "The required file '" & _
strDataDatabase & _
"' could not be found." & _
" You can use the next dialog box" & _
" to locate the file on your system." & _
" If you cannot find this file or" & _
" are unsure what to do choose CANCEL" & _
" at the next screen and call the" & _
" database administrator."
MsgBox strMsg, vbOKOnly + vbCritical, strProcName

' Display Open File dialog using
' adhCommonFileOpenSave from basFileOpen.
strFilter = adhAddFilterItem( _
strFilter, "Access (*.mdb)", "*.mdb")

varFileName = adhCommonFileOpenSave( _
OpenFile:=True, _
Filter:=strFilter, _
Flags:=cdlOFNHideReadOnly + cdlOFNNoChangeDir, _
InitDir:=strDBDir, _
DialogTitle:="Locate Data database file")

If IsNull(varFileName) Then
' User pressed Cancel.
strMsg = "You can't use this database " & _
"until you locate '" & strDataDatabase & "'."
MsgBox strMsg, _
vbOKOnly + vbCritical, strProcName
adhVerifyLinks = False
GoTo adhVerifyLinksDone
Else
varFileName = adhTrimNull(varFileName)
End If
End If

'Rebuild Links. Check for number of tables first.
#If USEDAO Then
Set db = CurrentDb
intNumTables = db.TableDefs.Count
#Else
Set cnn = CurrentProject.Connection
Set cat = New ADOX.Catalog
cat.ActiveConnection = cnn
intNumTables = cat.Tables.Count
#End If
varReturn = SysCmd(acSysCmdInitMeter, _
"Relinking tables", intNumTables)

' Loop through all tables. Reattach those
' with nonzero-length Connect strings.
intI = 0
#If USEDAO Then
For Each tdf In db.TableDefs
' If connect is blank, its not an Linked table.
If Len(tdf.Connect) > 0 Then
intI = intI + 1
tdf.Connect = ";DATABASE=" & varFileName

' The RefreshLink might fail if the new
' path isn't OK. So trap errors inline.
On Error Resume Next
tdf.RefreshLink
'If one link bad, return False.
If Err.Number <> 0 Then
adhVerifyLinks = False
GoTo adhVerifyLinksDone
End If
End If

varReturn = SysCmd(acSysCmdUpdateMeter, intI + 1)
Next tdf
#Else
For Each tbl In cat.Tables
' If Type = "LINK, it's a linked table.
If tbl.Type = "LINK" Then
intI = intI + 1
On Error Resume Next
' This next line recreates and refreshes link.
' This might fail if the new path
' isn't OK. So trap errors inline.
tbl.Properties("Jet OLEDB:Link Datasource") = _
varFileName
'If one link bad, return False.
If Err.Number <> 0 Then
adhVerifyLinks = False
GoTo adhVerifyLinksDone
End If
End If

varReturn = SysCmd(acSysCmdUpdateMeter, intI + 1)
Next tbl
#End If
adhVerifyLinks = True

adhVerifyLinksDone:
On Error Resume Next
varReturn = SysCmd(acSysCmdRemoveMeter)
#If USEDAO Then
Set tdf = Nothing
Set db = Nothing
#Else
Set tbl = Nothing
Set cat = Nothing
Set cnn = Nothing
#End If
Exit Function

adhVerifyLinksErr:
Select Case Err.Number
Case Else
Err.Raise Err.Number, Err.Source, _
Err.Description, Err.HelpFile, Err.HelpContext
End Select
Resume adhVerifyLinksDone
End Function

Sub SeekLocalOrLinkedDAO(ByVal strTable As String, _
ByVal strCompare As String, _
Optional ByVal strIndex As String = "PrimaryKey")

' Performs DAO Seek on table using the specified
' index and search criteria. Works with both
' local and linked Access tables.
'
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All Rights Reserved.
'
' In:
' strTable: Name of table
' strCompare: Comma delimited list of search values
' strIndex: Name of index. Default is "PrimaryKey"
' Out:
' Prints to the debug window list of field values
' or 'No match was found'.

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Dim strConnect As String
Dim strDb As String
Dim intDBStart As Integer
Dim intDBEnd As Integer

Const adhcDB = "DATABASE="

Set db = CurrentDb
' Grab connection string from tabledef
strConnect = db.TableDefs(strTable).Connect

' If connection string is "" then it's a local table.
' Otherwise, need to parse database portion of
' connection string.
strDb = ""
If Len(strConnect) > 0 Then
intDBStart = InStr(strConnect, adhcDB)
intDBEnd = InStr(intDBStart + Len(adhcDB), _
strConnect, ";")
If intDBEnd = 0 Then intDBEnd = Len(strConnect) + 1
strDb = Mid(strConnect, intDBStart + Len(adhcDB), _
intDBEnd - intDBStart)

' Open the external database.
Set db = DBEngine.Workspaces(0).OpenDatabase(strDb)
End If

' Need to open a table-type recordset to use Seek.
Set rst = db.OpenRecordset(strTable, dbOpenTable)
rst.index = strIndex

rst.Seek "=", strCompare

If Not rst.NoMatch Then
' This example is just printing out the
' values of each of the fields of the
' found record, but you get the idea...
For Each fld In rst.Fields
Debug.Print fld.Name & ": " & fld.Value
Next
Else
Debug.Print "No match was found."
End If

Set fld = Nothing
rst.Close
Set rst = Nothing
If Len(strDb) > 0 Then
db.Close
End If
Set db = Nothing
End Sub

Sub SeekLocalOrLinkedADO(ByVal strTable As String, _
ByVal varCompare As Variant, _
Optional ByVal strIndex As String = "PrimaryKey")

' Performs ADO Seek on table using the specified
' index and search criteria. Works with both
' local and linked Access tables.
'
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All Rights Reserved.
'
' In:
' strTable: Name of table
' varCompare: Array of search values
' strIndex: Name of index. Default is "PrimaryKey"
' Out:
' Prints to the debug window list of field values
' or 'No match was found'.

Dim cnn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim strDb As String

Set cnn = CurrentProject.Connection
Set cat = New ADOX.Catalog
cat.ActiveConnection = cnn

' If this is a linked table, strDB will contain
' the name of the source database, otherwise it
' will contain an empty string.
strDb = cat.Tables(strTable).Properties("Jet OLEDB:Link Datasource")

If Len(strDb) > 0 Then
' Open a connection to the external database.
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDb & ";"
End If

Set rst = New ADODB.Recordset
' Need to open a table-type recordset to use Seek.
rst.Open strTable, cnn, adOpenKeyset, _
adLockOptimistic, adCmdTableDirect
rst.index = strIndex

rst.Seek varCompare, adSeekFirstEQ

' If no match was found, EOF will be True.
If Not rst.EOF Then
' This example is just printing out the
' values of each of the fields of the
' found record, but you get the idea...
For Each fld In rst.Fields
Debug.Print fld.Name & ": " & fld.Value
Next
Else
Debug.Print "No match was found."
End If

Set fld = Nothing
rst.Close
Set rst = Nothing
Set cat = Nothing
If Len(strDb) > 0 Then
cnn.Close
End If
Set cnn = Nothing
End Sub




Randall Vollen
National City Bank Corp.

 

[hwkranger]

Option Compare Database
Option Explicit

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.

' This module provides a simple "front end" to
' the File Open/Save common dialogs. You needn't
' use this, unless you want to -- you can always
' use the CommonDialog class directly. But the
' previous version of the book had some code that
' used this entry point, so we've duplicated it
' here, using the CommonDialog class rather
' than using the API directly.

' Requires:
' CommonDialog
'
Public Function adhCommonFileOpenSave( _
Optional ByRef Flags As adhFileOpenConstants = 0, _
Optional ByVal Filter As String = "", _
Optional ByVal FilterIndex As Long = 1, _
Optional ByVal DefaultExt As String = "", _
Optional ByVal FileName As String = "", _
Optional ByVal DialogTitle As String = "", _
Optional ByVal InitDir As String = "", _
Optional ByVal hWndOwner As Long = 0, _
Optional ByVal OpenFile As Boolean = True) As String

' This is a simple entry point for displaying
' the Windows File Open/Save dialog box.
' The parameters are listed below, and all are optional.
'
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All Rights Reserved.
'
' In:
' Flags:
' One or more of the cdlOFN* constants, OR'd together.
' InitialDir:
' The directory in which to first look
' Filter:
' A set of file filters, in pairs, separated with "|".
' FilterIndex:
' 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt:
' Extension to use if the user doesn't enter one.
' FileName:
' Default value for the file name text box.
' DialogTitle:
' Title for the dialog.
' OpenFile:
' Boolean(True=Open File/False=Save As)
' Out:
' Return Value: The selected filename
' Notes:
' This function raises an error (cdlCancel) if
' the user presses the Cancel button on the dialog box.
' The caller of this code can handle that error in
' in an error handler.

On Error GoTo HandleErrors

Dim cdl As CommonDialog
Set cdl = New CommonDialog

' We're assuming that no one wants
' the screen (that's the window that has
' an hWnd of 0) as the owner for the dialog
' so assume that means the caller wants Access
' to be the owner. But you generally want
' to make a form be the owner.
If hWndOwner = 0 Then
hWndOwner = Application.hWndAccessApp
End If
With cdl
.CancelError = True
.hWndOwner = hWndOwner
.Filter = Filter
.FilterIndex = FilterIndex
.FileName = FileName
.DialogTitle = DialogTitle
.Flags = Flags
.DefaultExt = DefaultExt
.InitDir = InitDir
' If you want to modify this to
' accept other parameters (a callback
' function, for example), do it here.
If OpenFile Then
Call .ShowOpen
Else
Call .ShowSave
End If
' You might care to check the Flags member of the
' structure to get information about the chosen file.
' In this example, if you bothered to pass in a
' value for Flags, we'll fill it in with the outgoing
' Flags value.
If Not IsMissing(Flags) Then Flags = .Flags
adhCommonFileOpenSave = .FileName
End With

ExitHere:
On Error Resume Next
Set cdl = Nothing
Exit Function

HandleErrors:
Select Case Err.Number
Case cdlCancel
Err.Raise cdlCancel, , "User cancelled the dialog."
Case Else
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
End Select
Resume ExitHere
End Function

Public Function adhAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String

' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.
'
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All Rights Reserved.
'
' In:
' strFilter: existing file filter
' strDescription: new filter description
' varItem: new filter
' Out:
' Return value: new file filter

If IsMissing(varItem) Then varItem = "*.*"
adhAddFilterItem = strFilter & _
strDescription & vbNullChar & _
varItem & vbNullChar

End Function

Function adhTrimNull(ByVal strItem As String) As String

' Trims the Null from a string returned by an API call
'
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All Rights Reserved.
'
' In:
' strItem: string that contains null terminator
' Out:
' Return value: same string without null terminator

Dim intPos As Integer

intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
adhTrimNull = Left(strItem, intPos - 1)
Else
adhTrimNull = strItem
End If

End Function



Randall Vollen
National City Bank Corp.

 

[hwkranger]

Option Explicit

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'
' Provide access to the File Open/Save,
' Color and Font common dialogs.
' Works similarly to the CommonDialog
' ActiveX control, but adds more features,
' and doesn't implement Printer or Help
' support.

' NOTE: This class module contains
' some redundant code (that is, code
' copied from other modules) so that
' it can be imported and used in other
' applications without needing to
' also import any subsidiary modules.

' =================
' API Constants
' =================
Private Const HWND_DESKTOP = 0
Private Const LF_FACESIZE = 32
Private Const FNERR_BUFFERTOOSMALL = &H3003

' Modify the Open/Save dialog box.
Private Const WM_USER = &H400
Private Const CDM_FIRST = (WM_USER + 100)
Private Const CDM_SETCONTROLTEXT = (CDM_FIRST + &H4)
Private Const CDM_HIDECONTROL = (CDM_FIRST + &H5)

' =================
' API Enums (values defined by API,
' Enums defined here). These are set
' up to match the CommonDialog ActiveX
' control's constants, but we've added
' some extras.
' =================

Public Enum adhCDFontType
RASTER_FONTTYPE = &H1
DEVICE_FONTTYPE = &H2
TRUETYPE_FONTTYPE = &H4
BOLD_FONTTYPE = &H100
ITALIC_FONTTYPE = &H200
REGULAR_FONTTYPE = &H400
SCREEN_FONTTYPE = &H2000
PRINTER_FONTTYPE = &H4000
SIMULATED_FONTTYPE = &H8000
OPENTYPE_FONTTYPE = &H10000
TYPE1_FONTTYPE = &H20000
DSIG_FONTTYPE = &H40000
End Enum

Public Enum adhFontFaceAPI
ANSI_CHARSET = 0
DEFAULT_CHARSET = 1
SYMBOL_CHARSET = 2
SHIFTJIS_CHARSET = 128
HANGEUL_CHARSET = 129
GB2312_CHARSET = 134
CHINESEBIG5_CHARSET = 136
OEM_CHARSET = 255
JOHAB_CHARSET = 130
HEBREW_CHARSET = 177
ARABIC_CHARSET = 178
GREEK_CHARSET = 161
TURKISH_CHARSET = 162
VIETNAMESE_CHARSET = 163
THAI_CHARSET = 222
EASTEUROPE_CHARSET = 238
RUSSIAN_CHARSET = 204
MAC_CHARSET = 77
BALTIC_CHARSET = 186
End Enum

Public Enum adhColorConstants
cdlCCFullOpen = 2
cdlCCHelpButton = 8
cdlCCPreventFullOpen = 4
cdlCCRGBInit = 1
cdlCCAnyColor = &H100
cdlCCEnableHook = &H10
cdlCCSolidColor = &H80
End Enum

Public Enum adhErrorConstants
cdlAlloc = 32752
cdlBufferTooSmall = 20476
cdlCancel = 32755
cdlCreateICFailure = 28661
cdlDialogFailure = -32768
cdlDndmMismatch = 28662
cdlFindResFailure = 32761
cdlGetDevModeFail = 28666
cdlGetNotSupported = 394
cdlHelp = 32751
cdlInitFailure = 28665
cdlInitialization = 32765
cdlInvalidFileName = 20477
cdlInvalidPropertyValue = 380
cdlInvalidSafeModeProcCall = 680
cdlLoadDrvFailure = 28667
cdlLoadResFailure = 32760
cdlLoadStrFailure = 32762
cdlLockResFailure = 32759
cdlMemAllocFailure = 32758
cdlMemLockFailure = 32757
cdlNoDefaultPrn = 28663
cdlNoDevices = 28664
cdlNoFonts = 24574
cdlNoInstance = 32763
cdlNoTemplate = 32764
cdlParseFailure = 28669
cdlPrinterCodes = 28671
cdlPrinterNotFound = 28660
cdlRetDefFailure = 28668
cdlSetNotSupported = 383
cdlSetupFailure = 28670
cdlSubclassFailure = 20478
End Enum

Public Enum adhFileOpenConstants
cdlOFNAllowMultiselect = 512
cdlOFNCreatePrompt = 8192
cdlOFNEnableHook = 32
cdlOFNEnableSizing = 8388608
cdlOFNExplorer = 524288
cdlOFNExtensionDifferent = 1024
cdlOFNFileMustExist = 4096
cdlOFNHelpButton = 16
cdlOFNHideReadOnly = 4
cdlOFNLongNames = 2097152
cdlOFNNoChangeDir = 8
cdlOFNNoDereferenceLinks = 1048576
cdlOFNNoLongNames = 262144
cdlOFNNoNetworkButton = 131072
cdlOFNNoReadOnlyReturn = 32768
cdlOFNNoValidate = 256
cdlOFNOverwritePrompt = 2
cdlOFNPathMustExist = 2048
cdlOFNReadOnly = 1
cdlOFNShareAware = 16384
End Enum

Public Enum adhFontsConstants
cdlCFANSIOnly = &H400
cdlCFApply = &H200
cdlCFBoth = &H3
cdlCFEffects = &H100
cdlCFEnableHook = &H8
cdlCFFixedPitchOnly = &H4000
cdlCFForceFontExist = &H10000
cdlCFInitToLogFontStruct = &H40
cdlCFLimitSize = &H2000
cdlCFNoFaceSel = &H80000
cdlCFNoSimulations = &H1000
cdlCFNoSizeSel = &H200000
cdlCFNoStyleSel = &H100000
cdlCFNoVectorFonts = &H800
cdlCFNoVertFonts = &H1000000
cdlCFPrinterFonts = &H2
cdlCFScalableOnly = &H20000
cdlCFScreenFonts = &H1
cdlCFShowHelp = &H4
cdlCFTTOnly = &H40000
cdlCFUseStyle = &H80
cdlCFWYSIWYG = &H8000 ' must also have cdlCFScreenFonts & cdlCFPrinterFonts
End Enum

' You can use these values in the
' File Open/Save callback function
' to modify the text or visibility
' of any of the controls on the
' dialog. See the example callback
' function for a demo.
Public Enum adhFileOpenSaveControls
fosCurrentFolder = &H471
fosCurrentFolderLabel = &H443
fosContentsList = &H460
fosContentsListLabel = &H440
fosSelectedFile = &H480
fosSelectedFileLabel = &H442
fosFilterList = &H470
fosFilterListLabel = &H441
fosReadOnly = &H410
fosOKButton = 1
fosCancelButton = 2
fosHelpButton = &H40E
End Enum

' =================
' API Types
' =================
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(1 To LF_FACESIZE) As Byte
End Type

Private Type ChooseColor
lStructSize As Long
hWndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
Flags As adhColorConstants
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
NFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As adhFileOpenConstants
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Type ChooseFont
lStructSize As Long
hWndOwner As Long ' caller's window handle
hdc As Long ' printer DC/IC or NULL
lpLogFont As Long
iPointSize As Long ' 10 * size in points of selected font
Flags As adhFontsConstants ' enum. type flags
rgbColors As Long ' returned text color
lCustData As Long ' data passed to hook fn.
lpfnHook As Long ' ptr. to hook function
lpTemplateName As String ' custom template name
hInstance As Long ' instance handle of.EXE that
' contains cust. dlg. template
lpszStyle As String ' return the style field here
' must be LF_FACESIZE or bigger
nFontType As Integer ' same value reported to the EnumFonts
' call back with the extra FONTTYPE_
' bits added
MISSING_ALIGNMENT As Integer
nSizeMin As Long ' minimum pt size allowed &
nSizeMax As Long ' max pt size allowed if
' CF_LIMITSIZE is used
End Type

' =================
' API Declarations
' =================
Private Declare Function GetDC _
Lib "USER32" _
(ByVal hWnd As Long) As Long

Private Declare Function ReleaseDC _
Lib "USER32" _
(ByVal hWnd As Long, ByVal hdc As Long) As Long

Private Const LOGPIXELSY = 90
Private Declare Function GetDeviceCaps _
Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function MulDiv _
Lib "kernel32" _
(ByVal nNumber As Long, ByVal nNumerator As Long, _
ByVal nDenominator As Long) As Long

Private Declare Function CommDlgExtendedError _
Lib "comdlg32.dll" () As Long

Private Declare Function ChooseFont _
Lib "comdlg32.dll" Alias "ChooseFontA" _
(pChoosefont As ChooseFont) As Long

Private Declare Function ChooseColor _
Lib "comdlg32.dll" Alias "ChooseColorA" _
(pChoosecolor As ChooseColor) As Long

Private Declare Function GetOpenFileName _
Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

Private Declare Function GetSaveFileName _
Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

' =================
' Storage for property values.
' =================

' Returns/sets the size of the file name
' buffer to use for the FileOpen dialog box.
' The default size is 1000.
Public FileNameBufferSize As Long

' Returns/sets the custom file open/save filter.
' Public CustomFilter As String

' Returns/sets the default filename extension for the dialog box.
Public DefaultExt As String

' Sets the string displayed in the title bar of the dialog box.
Public DialogTitle As String

' Returns/sets the path and filename of a selected file.
Public FileName As String

' Returns/sets the name (without the path) of the file to open or save at run time.
Public FileTitle As String

' Returns/sets the filters that are displayed in the Type list box of a dialog box.
Public Filter As String

' Returns/sets a default filter for an Open or Save As dialog box.
Public FilterIndex As Long

' Returns/sets the initial file directory.
Public InitDir As String

' Returns/sets the selected color.
Public Color As Long

' Sets the hWnd of the dialog owner.
Public hWndOwner As Long

' Sets/Returns the character set.
' Although interesting, doesn't correspond
' to any property in the host app.
Public FontScript As adhFontFaceAPI

' Text describing the selected font style.
Public FontStyle As String

' Set/Returns the minimum and maximum font sizes,
' if you've set the cdlCFLimitSize flag.
' Disregarded otherwise.
Public Min As Integer
Public Max As Integer

' Returns the selected font color.
Public FontColor As Long

' Flag settings (for backwards compatability only)
Public Flags As Long

' Flags specific to the specific dialog box.
Public FontFlags As adhFontsConstants
Public ColorFlags As adhColorConstants
Public OpenFlags As adhFileOpenConstants

' Address of the callback function.
Public CallBack As Long

' Specifies the name of the font that appears in each row for the given level.
Public FontName As String

' Indicates whether an error is generated when the user chooses the Cancel button.
Public CancelError As Boolean

' Returns/sets italic font styles.
Public FontItalic As Boolean

' Returns/sets bold font styles. Included for
' backwards compatability. Use FontWeight
' instead.
Public FontBold As Boolean

' Font weight, from 100 to 900 (in multiples of 100)
' 700 is bold, 400 is normal.
Public FontWeight As Long

' Specifies the size (in points) of the font that appears in each row for the given level.
Public FontSize As Single

' Returns/sets strikethrough font styles.
Public FontStrikeThrough As Boolean

' Returns/sets underline font styles.
Public FontUnderline As Boolean

' Retrieve the font type, from the adhCDFontType
' list of options. Can be any number of
' items from the group, OR'd together.
Private mlngFontType As adhCDFontType

' Retrieve the 16 user-defined colors
' returned from the color chooser dialog.
Private malngColors(0 To 15) As Long

' Retrieve the offset within the full file name
' to the file portion, or the extension portion.
Private mlngFileOffset As Long
Private mlngFileExtOffset As Long

' Retrieve the list of files selected
' if cdlOFNAllowMultiSelect flag
' is set. If not, this array contains
' only the path, and single file selected.
Private mastrFileList() As String

Public Property Get FileList() As String()
' Get the parsed list of files.
' If there are items in this list,
' the 0th element is the path, and the
' rest are the selected files.
' Even if you only select a single
' file, we populate this array.
FileList = mastrFileList
End Property

Public Property Get FileOffset() As Long
' Returns the offset within the full file name
' to the file portion.
FileOffset = mlngFileOffset
End Property

Public Property Get FileExtOffset() As Long
' Returns the offset within the full file name
' to the file portion.
FileExtOffset = mlngFileExtOffset
End Property

Public Property Get CustomColors() As Long()
' Return the array of custom colors.
CustomColors = malngColors
End Property

Public Property Let CustomColors(Value() As Long)
Dim i As Integer

' The array passed in must be indexed from
' 0 to 15. If not, weird things are going
' to happen -- we just copy from those
' indexes directly over.
On Error GoTo HandleErrors
For i = 0 To 15
malngColors(i) = Value(i)
NextValue:
Next i

ExitHere:
Exit Property

HandleErrors:
Resume NextValue
End Property

Public Property Get FontType() As adhCDFontType
FontType = mlngFontType
End Property

' =================
' CommonDialog Methods
' =================
Public Sub ShowColor()

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'
' Displays the CommonDialog control's Color dialog box.

Dim cc As ChooseColor

Call SetColorProperties(cc)
If ChooseColor(cc) <> 0 Then
Call GetColorProperties(cc)
Else
' If the user wants to raise an error for the Escape
' do it now.
If CancelError Then
Err.Raise cdlCancel, , "Cancel was selected."
End If
End If
End Sub

Public Sub ShowFont()

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'
' Display the CommonDialog control's Font dialog box

Dim cf As ChooseFont
Dim lf As LOGFONT
Dim strStyle As String

' Arbitrarily allow 100 characters
' for the style string.
strStyle = Space(100)
Call SetFontProperties(cf, lf, strStyle)
If ChooseFont(cf) <> 0 Then
' The user pressed the OK button
Call GetFontProperties(cf, lf)
Else
' If the user wants to raise an error for the Escape
' do it now.
If CancelError Then
Err.Raise cdlCancel, , "Cancel was selected."
End If
End If
End Sub

Public Sub ShowOpen()

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'
' Displays the CommonDialog control's Open dialog box.

Dim ofn As OPENFILENAME
Dim lngErr As Long

Call SetOpenProperties(ofn)
If GetOpenFileName(ofn) <> 0 Then
Call GetOpenProperties(ofn)
Else
lngErr = CommDlgExtendedError()
Select Case lngErr
Case FNERR_BUFFERTOOSMALL
Err.Raise cdlBufferTooSmall, , _
"Filename buffer is too small for the selected files."
Case 0
' If the user wants to raise an error for the Escape
' do it now.
If CancelError Then
Err.Raise cdlCancel, , "Cancel was selected."
End If
Case Else
Err.Raise lngErr, , "Unexpected error."
End Select
End If
End Sub

Public Sub ShowSave()

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'
' Displays the CommonDialog control's Save As dialog box.

Dim ofn As OPENFILENAME
Dim lngErr As Long

Call SetOpenProperties(ofn)
If GetSaveFileName(ofn) <> 0 Then
Call GetOpenProperties(ofn)
Else
lngErr = CommDlgExtendedError()
Select Case lngErr
Case FNERR_BUFFERTOOSMALL
Err.Raise cdlBufferTooSmall, , "Filename buffer is too small for the selected files."
Case 0
' If the user wants to raise an error for the Escape
' do it now.
If CancelError Then
Err.Raise cdlCancel, , "Cancel was selected."
End If
Case Else
Err.Raise lngErr, , "Unexpected error."
End Select
End If
End Sub

Private Sub SetOpenProperties(ofn As OPENFILENAME)

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'

' Copy object properties into the data
' structure before calling the API.

Dim strFilename As String
Dim strFileTitle As String

' Show the Open common dialog.
' Allocate string space for the returned strings.
strFilename = String(FileNameBufferSize, vbNullChar)
LSet strFilename = FileName & vbNullChar
strFileTitle = String$(1024, vbNullChar)

With ofn
.lStructSize = Len(ofn)
.hWndOwner = hWndOwner
' The API doesn't want those "|" things, it wants
' vbNullChar, with an extra one on the end.
.lpstrFilter = Replace(Trim$(Filter), "|", vbNullChar) & vbNullChar
.NFilterIndex = FilterIndex
.lpstrFile = strFilename

.nMaxFile = Len(strFilename)
.lpstrFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.lpstrTitle = DialogTitle

' You can set either the OpenFlags
' or general Flags properties. We'll
' OR them together. If you use both, you'd
' better know what you're doing!
' In addition, we're going to assume that you
' always want the explorer-style interface.
' Can't imagine why you wouldn't, at this point.
.Flags = OpenFlags Or Flags Or cdlOFNExplorer
.lpstrDefExt = DefaultExt
.lpstrInitialDir = InitDir

' We don't support the CustomFilter
' property, but you could add it in
' if you like. This buffer
' must contain at least 40 characters
' to make WinNT happy.
.lpstrCustomFilter = String(40, vbNullChar)
.nMaxCustFilter = Len(.lpstrCustomFilter)

If .Flags And cdlOFNEnableHook Then
.lpfnHook = CallBack
End If
End With
End Sub

Private Sub GetOpenProperties(ofn As OPENFILENAME)

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'

' Retrieve properties from the API structure
' back into properties of this object.

Dim astrFileInfo() As String
Dim intPos As Integer
Dim strFilename As String

With ofn
FileName = .lpstrFile
OpenFlags = .Flags
Flags = .Flags
FileTitle = .lpstrFileTitle
FilterIndex = .NFilterIndex
mlngFileExtOffset = .nFileExtension
mlngFileOffset = .nFileOffset
' CustomFilter = .lpstrCustomFilter
If .nFileOffset > 0 Then
strFilename = .lpstrFile
If Mid$(strFilename, mlngFileOffset, 1) = vbNullChar Then
' Look for trailing double null chars, and trim
' the string there.
intPos = InStr(1, strFilename, vbNullChar & vbNullChar)
If intPos > 0 Then
strFilename = Left$(strFilename, intPos - 1)
End If
astrFileInfo = Split(strFilename, vbNullChar)
mastrFileList = astrFileInfo
Else
' Only a single file selected,
' so break it up into path and file
' portion, as if the user had selected
' multiple files.
ReDim mastrFileList(0 To 1)
mastrFileList(0) = Left$(strFilename, mlngFileOffset - 1)
mastrFileList(1) = adhTrimNull(Mid$(strFilename, mlngFileOffset + 1))
FileName = adhTrimNull(FileName)
End If
End If
End With
End Sub

Private Sub SetColorProperties(cc As ChooseColor)

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'

' Copy object properties into the data
' structure before calling the API.

cc.lStructSize = LenB(cc)
cc.hWndOwner = hWndOwner
cc.rgbResult = Color
cc.lpCustColors = VarPtr(malngColors(0))

' You can set either the ColorFlags
' or general Flags properties. We'll
' OR them together. If you use both, you'd
' better know what you're doing!
cc.Flags = ColorFlags Or Flags

' This had better be the address of
' a public function in a standard
' module, or you're going down!
' Use the adhFnPtrToLong procedure
' to convert from AddressOf to
' long.
If cc.Flags And cdlCCEnableHook Then
cc.lpfnHook = CallBack
End If
End Sub

Private Sub GetColorProperties(cc As ChooseColor)
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'

' Retrieve properties from the API structure
' back into properties of this object.

Color = cc.rgbResult
End Sub

Private Sub SetFontProperties( _
cf As ChooseFont, lf As LOGFONT, strStyle As String)
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'

' Copy object properties into the data
' structure before calling the API.

On Error Resume Next
Dim lngFlags As Long

cf.lStructSize = LenB(cf)
If Len(FontName) > 0 Then
Call adhSetFaceName(lf, FontName)
End If
cf.lpLogFont = VarPtr(lf)
cf.hWndOwner = hWndOwner
cf.lpszStyle = FontStyle

lf.lfHeight = CalcHeightFromPoints()
lf.lfStrikeOut = FontStrikeThrough
lf.lfUnderline = FontUnderline
lf.lfItalic = FontItalic
lf.lfCharSet = FontScript

If FontWeight = 0 Then
If FontBold Then
lf.lfWeight = 700
Else
lf.lfWeight = 400
End If
Else
lf.lfWeight = FontWeight
End If

cf.rgbColors = FontColor
cf.nSizeMax = Max
cf.nSizeMin = Min

' You can set either the FontFlags
' or general Flags properties. We'll
' OR them together. If you use both, you'd
' better know what you're doing!
' We also OR in cdlCFInitToLogFontStruct,
' 'cause you generally want to do that.

' In addition, if the user hasn't specified
' either/both cdlCFPrinterFonts or cdlCFScreenFonts
' we're going to assume they want both.
lngFlags = Flags Or FontFlags
If Not (lngFlags And cdlCFPrinterFonts) And _
Not (lngFlags And cdlCFScreenFonts) Then
lngFlags = lngFlags Or cdlCFBoth
End If
cf.Flags = lngFlags Or cdlCFInitToLogFontStruct

' This had better be the address of
' a public function in a standard
' module, or you're going down!
' Use the adhFnPtrToLong procedure
' to convert from AddressOf to
' long.
If cf.Flags And cdlCFEnableHook Then
cf.lpfnHook = CallBack
End If
End Sub

Private Sub GetFontProperties(cf As ChooseFont, lf As LOGFONT)

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'
' Retrieve properties from the API structure
' back into properties of this object.

On Error Resume Next
FontName = adhTrimNull(StrConv(lf.lfFaceName, vbUnicode))
FontColor = cf.rgbColors
FontItalic = lf.lfItalic
FontBold = ((cf.nFontType And BOLD_FONTTYPE) <> 0)
FontWeight = lf.lfWeight
FontSize = cf.iPointSize \ 10
FontStrikeThrough = lf.lfStrikeOut
FontUnderline = lf.lfUnderline
FontScript = lf.lfCharSet
FontStyle = adhTrimNull(cf.lpszStyle)
mlngFontType = cf.nFontType
End Sub

Private Function CalcHeightFromPoints() As Long

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'
Dim hdc As Long
Dim lngLogPixelsY As Long

On Error GoTo HandleErrors

' Assume an invalid value for failure.
CalcHeightFromPoints = 0

' Convert from points back to the internal
' device units value.
hdc = GetDC(HWND_DESKTOP)
If hdc <> 0 Then
lngLogPixelsY = GetDeviceCaps(hdc, LOGPIXELSY)
CalcHeightFromPoints = _
-1 * MulDiv(CInt(FontSize), lngLogPixelsY, 72)
End If

ExitHere:
Exit Function

HandleErrors:
Resume ExitHere
End Function

Private Sub Class_Initialize()
' Assume the default size.
FileNameBufferSize = 20000
End Sub

Private Function adhTrimNull(strVal As String) As String
' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.

' Trim the end of a string, stopping at the first
' null character.

Dim intPos As Integer
intPos = InStr(1, strVal, vbNullChar)
Select Case intPos
Case Is > 1
adhTrimNull = Left$(strVal, intPos - 1)
Case 0
adhTrimNull = strVal
Case 1
adhTrimNull = vbNullString
End Select
End Function

Private Sub adhSetFaceName(lf As LOGFONT, strValue As String)

' From Access 2000 Developer's Handbook, Volume II
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1999. All rights reserved.
'
' Given a string, get it back into the ANSI byte array
' contained within a LOGFONT structure.

Dim intLen As Integer
Dim intI As Integer
Dim abytTemp() As Byte

On Error GoTo HandleErrors

abytTemp = StrConv(strValue, vbFromUnicode)
intLen = UBound(abytTemp) + 1

' Make sure the string isn't too long.
If intLen > LF_FACESIZE - 1 Then
intLen = LF_FACESIZE - 1
End If
For intI = 1 To intLen
lf.lfFaceName(intI) = abytTemp(intI - 1)
Next intI
' Tack on a final Chr$(0).
lf.lfFaceName(intI) = 0

ExitHere:
Exit Sub

HandleErrors:
Resume ExitHere
End Sub



Randall Vollen
National City Bank Corp.

 

[jpiscit1]

Randell,

Thanks, I think. Not really sure what to do with that. There are 3 postings. Are all three the code that is needed? Where does it go Access? Where do i set the references to my server, PW, UN ,etc...

This link talks about setting it up automatically but does not tell you where to put the code ?

http://www.mvps.org/access/tables/tbl0010.htm

John

Your limits are only as far as you set your boundries......

 

[hwkranger]

Private Function ftest()
MsgBox (CurrentDb.TableDefs(1).Name)
CheckLink (CurrentDb.TableDefs(1).Name)
End Function



you can use

checklink (tablename)

what i would do it, use loop,

for i = 0to currentdb.tabledefs.count

CheckLink (CurrentDb.TableDefs(1).Name)

next i

that's how it works from the code that i have...


from MVPS

Const cREG_PATH = "Software\ODBC\ODBC.INI" is your DSN path, you'll have to set that. otherwise it automatically does it all.

Randall Vollen
National City Bank Corp.