FredixBlog

Need to connect to an Access database with ADO? Using workgroup security? Here is a function which will return an opened connection to the jet database:

Public Function GetJetConnection(strPath As String, _
         Optional strDBPwd As String, _
         Optional strSysDBPath As String, _
         Optional strUserID As String, _
         Optional strUserPwd As String) _
         As ADODB.Connection
   Dim cnnDB As ADODB.Connection
  
   Set cnnDB = New ADODB.Connection
   With cnnDB
      .Provider = “Microsoft.Jet.OLEDB.4.0″
      ‘.Mode = lngMode
      .Properties(”Jet OLEDB:Database Password”) = strDBPwd
      .Properties(”Jet OLEDB:System Database”) = strSysDBPath
      ‘.Properties(”Jet OLEDB:Engine Type”) = lngEngineType
      .Open ConnectionString:=strPath, _
            UserID:=strUserID, _
            Password:=strUserPwd
   End With

   Set GetJetConnection = cnnDB
End Function

Need an example? Here it is, connecting to the current database:

     Set rs = New ADODB.Recordset
    rs.Open “Select * from <TableName>”, _
        GetJetConnection(CurrentDb.Name, , <system DB path>, <user>, <password>), _
        adOpenKeyset, adLockOptimistic

Random Posts

• Nettoyage de la touche
• Poor man’s mastering: Mastering without a plugin
• How can I e-mail a file from Microsoft Access?
• Display a counter and remaining time in a loop
• Create ODBC DSN
• No match it returns a null value.
• ShopOnline4All.com’s Special Discounted Items
• Access Speed?
• Program Header
• Command line parameter

When browsing thru records, a while/wend loop can take a long time to execute, depending on the number of records, communication speed and complexity of the process.

Here is a snippet that displays a counter, including estimated remaining time. After a few records browsed thru the loop, a rather accurate estimate of the remaining time can be displayed.

‘ Declarations
Dim starttime
Dim elapsedtime
Dim estimatedtime
Dim count
Dim counttot
Dim estHours, estMinutes, estSeconds

‘ Initializations: Code to be pasted BEFORE the while/wend loop
count = 0
counttot = <whichever way you could get the number of records to be processed: DCOUNT, VIEW, rs.RecordCount>
starttime = Now()

‘ Displaying the count: Code to be pasted at the end of the loop, when jumping to the next record
    count = count + 1
    elapsedtime = DateDiff(”s”, starttime, Now())
    estimatedtime = elapsedtime / (count + 0.00001) ‘ time for one record
    estimatedtime = estimatedtime * (counttot - count) ‘ time for remaining records

    estHours = Int(estimatedtime / 3600)
    estMinutes = Int((estimatedtime - 3600 * estHours) / 60)
    estSeconds = Int(estimatedtime - (60 * estMinutes))
    If count / 100 = Int(count / 100) Then Echo True, “Uploading ” & SourceTable & ” on ” & Get_rawmeasuresDb(CurrentDb.Name) & ” : ” & count & “/” & counttot & ” records processed ” & ” Remaining: ” & Format(TimeSerial(estHours, estMinutes, estSeconds), “hh:mm:ss”)

Random Posts

• How can I e-mail a file from Microsoft Access?
• Relink all tables
• Coordinates of the third point
• GetOpenFileName()
• On Error code
• All books by author
• ShellWait()
• La rocaille (1)
• Practice the blues in all keys
• Clear all line breaks

If you are like me, always needing ADO recordsets but your memory is still weak?
Here are the lines of code to open ADO recordset against a MS-SQL Server database.
In addition, it address either the development server/database if the Access frontend is stored in a development environment, or the production database/server when in production. No need to bother about the SQL-Server database: When in development, your frontend’s folder just has to contain the word “Devel” in it.

‘ Declaring the ADODB objects
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset

‘ Opening the connection
Set conn = New ADODB.Connection
conn.ConnectionTimeout = 0
conn.CommandTimeout = 0
conn.Open “driver={SQL Server};DSN=” & Get_Db(CurrentDb.Name) & “;server=” & Get_Server(CurrentDb.Name) & “;DATABASE=” & Get_Db(CurrentDb.Name) & “;APP=Microsoft® Access;Trusted_Connection=Yes;Connect Timeout=0″

‘ Opening the recordset
Set rs = New ADODB.Recordset
rs.Open “Select * from [<name of the table>]“, conn, adOpenKeyset, adLockOptimistic
If Not rs.EOF Then rs.MoveFirst

Here are the two ‘environment sensitive’ functions:

Public Function Get_Db(dbName As String)
    If InStr(UCase(dbName), UCase(”Devel”)) = 0 Then
     Get_Db = “<name of the ODBC DSN for the PRODUCTION database>”
    Else
        Get_Db = “<name of the ODBC DSN for the DEVELOPMENT database>”
    End If
End Function

Public Function Get_Server(dbName As String)
    If InStr(UCase(dbName), UCase(”Devel”)) = 0 Then
        Get_Server = “<name of the server for the PRODUCTION>”
    Else
        Get_Server = “<name of the server for the DEVELOPMENT>”
    End If
End Function

Random Posts

• Guitare-Live 2004/2007
• La Serre 2 - La fin du trou
• Copy a file
• Disable shift key
• Custom Autonumber Access 2000
• TMP files
• Nettoyage de la touche
• Dirty Flag for unbound form
• I like this game
• Coordinates of the third point

This function is useful when displaying or logging long path names.

Too long path names are annoying in a log file, because they are very often the same. Truncating the path to show only the beginning and the end helps readability.

Public Function TruncatedPath(TheText)
Dim pos1 As Integer
Dim pos2 As Integer
Dim ch As String
Dim i As Integer

pos1 = InStr(3, TheText, “\”)
i = Len(TheText)
ch = Mid(TheText, i, 1)
While ch <> “\”
    i = i - 1
    ch = Mid(TheText, i, 1)
Wend
pos2 = Len(TheText) - i + 1

TruncatedPath = Left(TheText, pos1) & “…” & Right(TheText, pos2)
End Function

Random Posts

• Copy a file
• Top 20 bookmarking sites.
• Format a floppy in ACCESS without creating a batch file
• Clear all line breaks
• Message to log file
• Custom Autonumber Access 2000
• ShellWait()
• AddReference()
• BuildQuery()
• On Error code

It is often needed to know wether or not a file exists.
This simple function will do the job.
For instance, if we need to delete a file if it exists:

If FileExists(”c:\myfile.txt”) Then
    Kill “c:\myfile.txt”
End If

Here is the code of the function:

Public Function FileExists(FileName)
    On Error Resume Next
    Open FileName For Input As 1
    If Err = 0 Then
        FileExists = True
        Close 1
    Else
        FileExists = False
    End If
End Function

Random Posts

• Replicate a database
• WeekMonday()
• Message to log file
• TMP files
• How can I e-mail a file from Microsoft Access?
• GetOpenFileName()
• ShellWait()
• Truncate long path names
• Create a linked table with VBA
• Relink all tables