Home ] MS Excel Solutions ] [ MS Access Page ] SQL Server ] Tech Links ]

MS Access Solution Centre.
As I am doing more work in Microsoft Access I have found this information to be very useful. I hope you do too.


Free MS Access Tutorial (very good)
Dealing with Database Corruption
Most Helpful Access Links
Reserved Words in MS Access
Sample/Examples of database models and schema
 
Stop mouse wheel scrolling to new record
MS Access 2007 Help
Import data from Excel to Access
Query to list all fields in a table
 

The most helpful MS Access Sites I have found:
[Back to Menu List]

Access Mailing List that are very helpful:
http://databaseadvisors.com/mailman/listinfo/accessd

http://peach.ease.lsoft.com/scripts/wa.exe?A0=ACCESS-L&X=-

Other Sites
Roger's Access Library: http://www.rogersaccesslibrary.com/
Allen Browne: http://allenbrowne.com/Access2007.htm
Dev Ashish's The Access Web: http://www.mvps.org/access/index.html
Martin Green's Access Tips: http://www.fontstuff.com/access/index.htm
Leban's freeware: http://www.lebans.com/toc.htm
Helen Feddema's code samples: http://www.helenfeddema.com/CodeSamples.htm
Microsoft Support Knowledge Base: http://support.microsoft.com/search
Simply Access: http://www.simply-access.com/
ACG: http://www.groupacg.com/

Fabalou Web:
http://www.fabalou.com/cask/index.asp


Learn MS Access for Free:
[Back to Menu List]

I mean really for free, nothing to sign up to, no advertising, no catches, no annoying spyware.  I found this site several years ago and it has been just great:  Download the PDF and the components and off you go.  There is a zip file at the bottom of the page that contains all the components you need:

See: http://www.sfubusiness.ca/motmba/courses/bus756/shared/pages/tutorials.html for full download options and details.

For other free MS Access Lessons:
http://office.microsoft.com/en-us/training/default.aspx

http://www.techdocs.ku.edu/?access
http://www.freecomputertraining.com.au/main/page_community_home.html

Learn how to code VBA for MS Access (free):
Drew Wutka has a nice little 40+ page tutorial available as a zip file download
http://www.marlow.com/VBA_Training.zip


Microsoft Access Database Corruption?
[Back to Menu List]

Try 'compact and repair. Splitting the database is certainly a very good idea especially if it's just one
user's computer causing the corruption. For more good ideas on corruption:

Tony Toews has an excellent web page on database corruption.
http://www.granite.ab.ca/access/corruptmdbs.htm

Allen Brown also has excellent info on corruption.
http://allenbrowne.com/ser-47.html

Jerry Whittle has a white paper in a Word document named Fix Corrupt Access Database
towards the bottom link page:
http://www.rogersaccesslibrary.com/OtherLibraries.asp

 


Database models and schema. Dozens of Examples, excellent site
[Back to Menu List]

http://www.databaseanswers.org/data_models/


Stop the mousewheel from scrolling to another recording in MS Access Forms.
[Back to Menu List]

This issue has finally been fixed in Access 2007, however if you are like most folks and still use an older version of Access then you need to do the following to make the mouse wheel behave in Access as the user expects I had to do the following.

If you have Admin rights and/or can access your system folder then a neat and quick fix is available through the Lebans site at the link below:
http://www.lebans.com/mousewheelonoff.htm

It took days of research to make this work as I could not access the registry or have any admin rights and IT techs wouldn't install the file automatically. Don't freak out if it looks too hard as more than half of this code is used to ensure the DAO350.dll and Mousewheel.dll files are registered correctly. If you have admin rights then you can skip all that bit without bother.  NOTE!! You will have to change/check the directory paths in some of that code - I just copied what worked for me directly into this page, but your folder path(s) will be different in places.  When I get more time I will try and tweak it for you.

Anyway.. here is what you do.

PART ONE

1: MOUSE WHEEL SUPPORT
' ---------------------------------------------------------------------------------------------------------

Download and install Freewheel. It is free, non hostile, don't need to register and don't need admin rights to install. I have used on personal PC's and on multiple corporate networks for years without any hassles ever.  It will ensure the mouse wheel behaves as the user expects, although it does not prevent the skipping between records issue.  Mouse wheel is available via this site of follow the direct link below.

http://www.geocities.com/SiliconValley/2060/freewheel.html
Personally, this is the one I would recommend as it fixes the mouse wheel problem *everywhere* in all apps - it just works.

Microsoft also have a solution (at least for the VBE - not sure if it fixes all mouse wheel issues in other apps or not).
http://office.microsoft.com/en-us/help/HA101175901033.aspx
That you may wish to consider if you don't want to use freewheel, however you need admin rights and registry access to do this.


2: MouseWheel.dll
' ------------------------------------------------------------------------------------------------
"MouseWheel.dll" is used to capture the mouse wheel event and prevent the user from using the mouse wheel to jump between records.

MouseWheel.dll source code and details are located here: http://support.microsoft.com/kb/278379.  I have already made this file and made it available for download in these instructions. I am providing the link in case there is some issue about using a dll file that you didn't make and it also give your instructions in case I foul these instuctions up somewhere.  If you don't have VB6, or cannot make the file yourself, you can download the dll file by clicking HERE.

If like me you get this error http://support.microsoft.com/kb/292054 then the DAO350.dll and Mousewheel.dll file need to be registered.  You can normally do this via the START > RUN option (see the MS link for details above for details) or you can workaround this by opening the VBE in MS Access, un-reference and then re-reference the MouseWheel.dll file manually and restart. However this is clearly not acceptable if you are not the end user. If you are like me and your corporate PC(s) is/are locked down tighter than a snake's bum and/or the above options are unavailable to you then I have code which will automatically register the dll files for you which I have posted at the bottom of these instructions.  The links where I orginally found this information is contained in the code.

In addition to the mouse wheel dll file you will need to do the following.

Create a regular code module in the VBE - Call it "basSubClassWindow" and copy and paste the following code into it.

' =========== START CODE =====================

Option Compare Database
Option Explicit

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
   (ByVal hwnd As Long, _
   ByVal nIndex As Long, _
   ByVal dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
   (ByVal lpPrevWndFunc As Long, _
    ByVal hwnd As Long, _
    ByVal msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long


Public Const GWL_WNDPROC = -4
Public Const WM_MouseWheel = &H20A
Public lpPrevWndProc As Long
Public CMouse As CMouseWheel

Public Function WindowProc(ByVal hwnd As Long, _
   ByVal uMsg As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long

   'Look at the message passed to the window. If it is
   'a mouse wheel message, call the FireMouseWheel procedure
   'in the CMouseWheel class, which in turn raises the MouseWheel
   'event. If the Cancel argument in the form event procedure is
   'set to False, then we process the message normally, otherwise
   'we ignore it.  If the message is something other than the mouse
   'wheel, then process it normally
   Select Case uMsg
       Case WM_MouseWheel
           CMouse.FireMouseWheel
           If CMouse.MouseWheelCancel = False Then
               WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
           End If


       Case Else
          WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
   End Select
End Function

' =========== END CODE =====================


Now for each form you want to restrict the mouse wheel you need to add the following code in the FORM code module

' =========== START CODE =====================

Option Compare Database
Option Explicit

Private WithEvents clsMouseWheel As MouseWheel.CMouseWheel

Private Sub Form_Load()
   On Error GoTo Form_Load_Error

   Set clsMouseWheel = New MouseWheel.CMouseWheel
   Set clsMouseWheel.Form = Me
   clsMouseWheel.SubClassHookForm

  'On Error GoTo 0
  Exit Sub

Form_Load_Error:

   'MsgBox "Mouse Wheel Restrictor File Needs Attention, Please seek assistance", vbInformation, "Contact IT Helpdesk..."
End Sub

Private Sub Form_Close()
  On Error GoTo Form_Close_Error

  clsMouseWheel.SubClassUnHookForm
  Set clsMouseWheel.Form = Nothing
  Set clsMouseWheel = Nothing

  'On Error GoTo 0
  Exit Sub

Form_Close_Error:

   'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_Close of VBA Document Form_frm_SubCurrentAchievments"
End Sub

Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
   MsgBox "You cannot use the mouse wheel to scroll records."
   Cancel = True
End Sub

' =========== END CODE =====================

 


PART TWO (only needed if you get the 429 Active X error)

That code above should work fine for you - However as I couldn't register the mousewheel.dll file the 'normal' way I kept getting
 "Active X 429 - Cannot create object" Error.  If you are getting this then apply the following fix.

IN CASE OF ACTIVE X 429 ERROR.
Create a normal code module and call it "Function_DaoReg" - then copy the following code - you will need to check/change the PATH for some of the code that follows.

' =========== START CODE =====================

Option Compare Database
Option Explicit
 

' Original code for this was found at the following two links, many thanks to Trigeminal.
'http://www.trigeminal.com/usenet/usenet026.asp
'http://www.trigeminal.com/code/RegisterDao.bas

Private Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const ERROR_SUCCESS = 0&
Public Const MAX_PATH = 260
Public Const S_OK = &H0

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private 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 Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Declare Function RegDaoDll Lib "dao360.dll" Alias "DllRegisterServer" () As Long

Private Const REGKEY As String = "SOFTWARE\Microsoft\Windows\CurrentVersion"
Private Const REGVAL As String = "CommonFilesDir"
Private Const DLLLOCATION As String = "\Microsoft Shared\DAO\dao360.dll"

Public Function DaoReg() As Boolean
Dim hKey As Long
Dim stName As String
Dim cb As Long
Dim hMod As Long
   ' First, find DAO. Ordinarily we could call the shell32/shfolder
   ' functions to find the location of the "Common Files" folder,
   ' but this will not work on Windows 95. So, go right to the
   ' registry to find:
   '   $(PROGRAM FILES)\$(COMMON FILES)\Microsoft Shared\DAO

   If (ERROR_SUCCESS = RegOpenKeyEx(HKEY_LOCAL_MACHINE, REGKEY, 0, KEY_QUERY_VALUE, hKey)) Then
       cb = MAX_PATH
       stName = String$(cb, vbNullChar)

       If (ERROR_SUCCESS = RegQueryValueEx(hKey, REGVAL, 0&, ByVal 0&, ByVal stName, cb)) Then
           ' Ok, now build the full DLL path
           stName = StFromSz(stName) & DLLLOCATION

           ' Load DAO so we can try to register it
           hMod = LoadLibrary(stName)
           If hMod Then
               ' Find out if the registration works
               DaoReg = (RegDaoDll() = S_OK)

               Call FreeLibrary(hMod)
           End If
       End If
       Call RegCloseKey(hKey)
   End If
End Function

'------------------------------------------------------------
'   StFromSz
'
'    Find the first vbNullChar in a string, and return
'    everything prior to that character. Extremely
'    useful when combined with the Windows API function calls.
'------------------------------------------------------------
Public Function StFromSz(ByVal sz As String) As String

   Dim ich As Integer

   ich = InStr(sz, vbNullChar)
   Select Case ich
       ' It's best to put the most likely case first.
       Case Is > 1
           ' Found in the string, so return the portion
           ' up to the null character.
           StFromSz = Left$(sz, ich - 1)
       Case 0
           ' Not found at all, so just
           ' return the original value.
           StFromSz = sz
       Case 1
           ' Found at the first position, so return an empty string.
           StFromSz = vbNullString
   End Select
End Function

' =========== END CODE =====================

Create another code module, call it "Function_RegisterMouseWheel" and add in the following code

' =========== START CODE =====================

Option Compare Database
Option Explicit

'http://www.trigeminal.com/usenet/usenet026.asp
'http://www.trigeminal.com/code/RegisterDao.bas

Private Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const ERROR_SUCCESS = 0&
Public Const MAX_PATH = 260
Public Const S_OK = &H0

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private 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 Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Declare Function RegDaoDll Lib "MouseWheel.dll" Alias "DllRegisterServer" () As Long

'\\dingo\grpdata\IT Project Status Reporting\Icons\MouseWheel.dll

Private Const REGKEY As String = "SOFTWARE\Microsoft\Windows\CurrentVersion"
Private Const REGVAL As String = "CommonFilesDir"
Private Const DLLLOCATION As String = "\\dingo\grpdata\IT Project Status Reporting\Icons\MouseWheel.dll"

Public Function DaoMouseWheel() As Boolean
Dim hKey As Long
Dim stName As String
Dim cb As Long
Dim hMod As Long
   ' First, find DAO. Ordinarily we could call the shell32/shfolder
   ' functions to find the location of the "Common Files" folder,
   ' but this will not work on Windows 95. So, go right to the
   ' registry to find:
   '   $(PROGRAM FILES)\$(COMMON FILES)\Microsoft Shared\DAO

   If (ERROR_SUCCESS = RegOpenKeyEx(HKEY_LOCAL_MACHINE, REGKEY, 0, KEY_QUERY_VALUE, hKey)) Then
       cb = MAX_PATH
       stName = String$(cb, vbNullChar)

       If (ERROR_SUCCESS = RegQueryValueEx(hKey, REGVAL, 0&, ByVal 0&, ByVal stName, cb)) Then
           ' Ok, now build the full DLL path
           stName = DLLLOCATION 'StFromSz(stName) &

           ' Load DAO so we can try to register it
           hMod = LoadLibrary(stName)
           If hMod Then
               ' Find out if the registration works
               DaoMouseWheel = (RegDaoDll() = S_OK)

               Call FreeLibrary(hMod)
           End If
       End If
       Call RegCloseKey(hKey)
   End If
End Function

'------------------------------------------------------------
'   StFromSz
'
'    Find the first vbNullChar in a string, and return
'    everything prior to that character. Extremely
'    useful when combined with the Windows API function calls.
'------------------------------------------------------------
Public Function StFromSz(ByVal sz As String) As String

   Dim ich As Integer

   ich = InStr(sz, vbNullChar)
   Select Case ich
       ' It's best to put the most likely case first.
       Case Is > 1
           ' Found in the string, so return the portion
           ' up to the null character.
           StFromSz = Left$(sz, ich - 1)
       Case 0
           ' Not found at all, so just
           ' return the original value.
           StFromSz = sz
       Case 1
           ' Found at the first position, so return an empty string.
           StFromSz = vbNullString
   End Select
End Function

' =========== END CODE =====================

Create a 3rd module, call it "CreateMouseWheelRef_" and add the following code

' =========== START CODE =====================
Option Compare Database
Option Explicit

Sub CreateMouseWheelReference()

Dim sPATH As String
Dim ref As Access.Reference

For Each ref In References
   If ref.IsBroken = True Then
       On Error Resume Next
       Access.References.Remove ref
   End If
Next ref

For Each ref In References
   If ref.name = "MouseWheel" Then
       If ref.IsBroken = True Then
           Access.References.Remove ref
       Else
           Exit Sub
       End If
   End If
Next ref

sPATH = "\\dingo\grpdata\IT Project Status Reporting\Icons\MouseWheel.dll"
'sPATH = "\\goanna\grpdata\PMO Team\DarrylCollins\Test Database\Icons\MouseWheel.dll"

If ReferenceFromFile(sPATH) = True Then
   MsgBox "Reference set successfully. Automatic Compile will take approx 30 seconds...", vbInformation, "Please Note:"
Else
   MsgBox "MouseWheel Reference not set successfully. - Please Contact PMO for Advice.", vbCritical, "Action Required!"
   'Application.Quit
End If

' Call a hidden SysCmd to automatically compile/save all modules.
Call SysCmd(504, 16483)

End Sub

' =========== END CODE =====================


Then in the MAIN MENU or Startup FORM when the database opens place the following code

' =========== START CODE =====================
Private Sub Form_Open(Cancel As Integer)

DoCmd.Maximize

Call DaoReg
Call DaoMouseWheel
Call CreateMouseWheelReference

' =========== END CODE =====================


Problem names and reserved words in Access

For a list of reserved words in MS Access see:
http://www.allenbrowne.com/AppIssueBadWord.html


Importing data from Excel to Access (using Access as the Master and Excel the Slave).

Drew Wutka has provided a useful method if you want to try the recordset method of moving data from Excel to Access.

Also see the Excel pages in this website for zipped examples of transferring data from Excel to Access.

If none of these samples help you out I suggest you try the link below which details the pros and cons of all methods of using code to transfer data between Access and Excel: http://www.zmey.1977.ru/Access_To_Excel.htm#a1

In testing I have found this works fast and has proven to be very useful.  This code example assumes you have an Excel named range and you know what that is.  I use this method as all my workbooks have their datasets in named ranges and I know exactly what data I am grabbing.  There is another method I have provided that you can use if you have no idea what is in the workbook and you want Access to return all sheet and range names.

You need to have an Access Table setup the same as the Excel dataset. In my case this is not an issue as all my datasets are tabular, normalised and use headers.  You need to put the following code into an MS Access VBE Module.

'-------------------Start of Code------------------------------------------------------

Function ImportExcelData()
Dim XLcnn As ADODB.Connection
Dim XLrs As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim strSheetName As String
Dim i As Long

Set XLcnn = New ADODB.Connection
XLcnn.Provider = "Microsoft.Jet.OLEDB.4.0"
XLcnn.Properties("Extended Properties") = "Excel 8.0;HDR=No"

XLcnn.Open "E:\tblRequests.xls"

Set rs = New ADODB.Recordset

rs.Open "tblRequests", CurrentProject.Connection, adOpenKeyset, _
adLockOptimistic, adCmdTableDirect

Set XLrs = New ADODB.Recordset
XLrs.Open "NameOfYourDataRange", XLcnn, adOpenKeyset, adLockReadOnly, _
adCmdTableDirect

If XLrs.EOF = False Then XLrs.MoveFirst
Do Until XLrs.EOF = True
   rs.AddNew
   For i = 0 To XLrs.Fields.Count - 1
       If Not IsNull(XLrs.Fields(i).Value) Then
           rs.Fields(XLrs.Fields(i).Name).Value = XLrs.Fields(i)
       End If
   Next i
   rs.Update
   XLrs.MoveNext
Loop
rs.Close
Set rs = Nothing
XLrs.Close
Set XLrs = Nothing
XLcnn.Close
Set XLcnn = Nothing
MsgBox "Done"
End Function

' ---------------End of Code---------------------------------

Where you would need to replace "NameOfYourDataRange" with the name
of the range you want to use (and also the E:\tblRequests.xls with the
name of the .xls file you want to use).

Many thanks to Drew Wutka and Gustav Brock from the Access D list for all their assistance with this.

So why use this method? Below is details as the advantages of this approach that were provided by Drew:

There are several advantages to this method.  One, Excel is never opening.  It's all done with Jet's 'understanding' of Excel.  Two, it's
fast.  A few years ago, I had to create a routine that automatically imported several spreadsheets into a network database.  Using Automation
took several minutes to import a few hundred.  Using recordsets, it ran several hundred in a few seconds.  I'm sure TransferSpreadsheet is
pretty fast too.  Three, unlike TransferSpreadsheet, you have complete control at the single field level to perform any kind of logic you might
need (verifying data, etc).  Four, though this probably won't apply, but you don't have to have Access OR Excel installed on a machine to run
this kind of code (though my example is using currentproject.connection, because I wrote it in an Access .mdb.  Put this code in VB, and a
non-Office program can copy data from an .xls file to an .mdb file, without having office installed).

Another advantage is that I believed you mentioned that there could be multiple spreadsheets, and a variable number of columns in each.  Not
sure what you are doing to determine these variables, using TransferSpreadsheet, but with the example above, you should be able to
see that you can get how many sheets are in the spreadsheet, and how many fields/columns there are.

Here is the code you can use if you have no idea what to expect in the source Excel File.  Drew has added some comments to help.
' --------------- Start Code ----------------------------------
Function ImportExcelData()
Dim XLcnn As ADODB.Connection
Dim XLrs As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim strSheetName As String
Dim i As Long
'Create Excel ADO Connection object
Set XLcnn = New ADODB.Connection
XLcnn.Provider = "Microsoft.Jet.OLEDB.4.0"
'Define Connection Object to connect to excel
'Note, HDR=No will not use the first fields as field names
XLcnn.Properties("Extended Properties") = "Excel 8.0;HDR=Yes"
'Open the excel file
XLcnn.Open "E:\tblRequests.xls"
'Get the list of tables names (sheet names, with a $)
Set rs = XLcnn.OpenSchema(adSchemaTables)
'This line gets the first table/sheet
rs.MoveFirst
strSheetName = rs.Fields("TABLE_NAME").Value
rs.Close
'Create and open the Access table recordset
Set rs = New ADODB.Recordset
rs.Open "tblRequests", CurrentProject.Connection, adOpenKeyset,
adLockOptimistic, adCmdTableDirect
'Create and open the Excel recordset
Set XLrs = New ADODB.Recordset
XLrs.Open strSheetName, XLcnn, adOpenKeyset, adLockReadOnly,
adCmdTableDirect
If XLrs.EOF = False Then XLrs.MoveFirst
Do Until XLrs.EOF = True
   'We are adding a new record for each Excel record.
   rs.AddNew
   For i = 0 To XLrs.Fields.Count - 1
       'This example uses an excel file and table with the same field
names
       'other methods could be used to match the fields
       'We are also checking for nulls before we add data to the field
       If Not IsNull(XLrs.Fields(i).Value) Then
           rs.Fields(XLrs.Fields(i).Name).Value = XLrs.Fields(i)
       End If
   Next i
   rs.Update
   XLrs.MoveNext
Loop
'close everything up
rs.Close
Set rs = Nothing
XLrs.Close
Set XLrs = Nothing
XLcnn.Close
Set XLcnn = Nothing
MsgBox "Done"
End Function
' --------------- End Code ----------------------------------


Query to list all fields in a table

Here's a function that I've used for ages.  If you only need field names, you can ignore the GetType() function, and remove the call in the TableInfo function.
 

'==========================================
Function TableInfo(strTableName As String)
Dim lngFile As Long, strText As String

  On Error GoTo TableInfoErr
  ' Purpose: Print in the immediate window the field names,
  ' types, and sizes for any table.
  ' Argument: name of a table in the current database.

  Dim db As Database, tdf As TableDef, i As Integer
  Set db = DBEngine(0)(0)
  Set tdf = db.TableDefs(strTableName)
  lngFile = FreeFile
  For i = 0 To tdf.Fields.Count - 1
     Debug.Print tdf.Fields(i).Name,
     Debug.Print GetType(tdf.Fields(i).Type),
     Debug.Print tdf.Fields(i).Size
  Next

TableInfoExit:
 Set db = Nothing
  Exit Function

TableInfoErr:
  Select Case Err
  Case 3265   ' Supplied table name invalid
     MsgBox strTableName & " table doesn't exist"
  Case Else
     Debug.Print "TableInfo() Error " & Err & ": " & Error
  End Select
  Resume TableInfoExit
End Function

Function GetType(l_Type As Long) As String
Dim strType As String
  Select Case l_Type
  Case Is = dbBigInt
     strType = "Big Integer"
  Case Is = dbBinary
     strType = "Binary"
  Case Is = dbBoolean
     strType = "Boolean"
  Case Is = dbByte
     strType = "Byte"
  Case Is = dbChar
     strType = "Char"
  Case Is = dbCurrency
     strType = "Currency"
  Case Is = dbDate
     strType = "Date"
  Case Is = dbDecimal
     strType = "Decimal"
  Case Is = dbDouble
     strType = "Double"
  Case Is = dbFloat
     strType = "Float"
  Case Is = dbGUID
     strType = "GUID"
  Case Is = dbInteger
     strType = "Integer"
  Case Is = dbLong
     strType = "Long"
  Case Is = dbLongBinary
     strType = "Long Binary"
  Case Is = dbMemo
     strType = "Memo"
  Case Is = dbNumeric
     strType = "Numeric"
  Case Is = dbSingle
     strType = "Single"
  Case Is = dbText
     strType = "Text"
  Case Is = dbTime
     strType = "Time "
  Case Is = dbTimeStamp
     strType = "TimeStamp"
  Case Is = dbVarBinary
     strType = "VarBinary"
  End Select
  GetType = strType
End Function

'=================================================
--
Many thanks to Dave M - Access Mailing List.

 


 

Home ] MS Excel Solutions ] [ MS Access Page ] SQL Server ] Tech Links ]