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.
|
|
MS Access Solution Centre. |
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
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
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
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/mousewhe
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
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
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
If like me you get this error
http://support.microsoft.com
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.SubClassUnHookFo
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
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
'http://www.trigeminal.com/code
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
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
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
'http://www.trigeminal.com/code
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
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
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/
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)
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(
'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)
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.