FredixBlog

Lorsqu’on a beaucoup de tâches à planifier avec le cron unix, il devient ardu de calculer de tête la bonne heure pour planifier chaque job. Facile pour une ou deux tâches, quand on a des dizaines de jobs à lancer pour une journée, un bon départ est de les répartir uniformément. On pourra toujours réajuster par la suite selon leur durée, mais il nous faut bien avoir une bonne façon de calculer cette répartition.

Les deux fonctions qui suivent vont faire ce travail. En prime, la possibilité de répartir les tâches sur plusieurs jours, jusqu’à 30. On peut ainsi programmer un grand nombre de tâches réparties sur tout un mois.

On lance Repartir(<Nombre de Tâches>,<Nombre de jours>)

Par exemple, pour répartir 6 tâches dans une journée, on fait:

call Repartir(6,1)

Pour lancer 250 jobs à faire en un mois:

call Repartir(250,30)

On récupère ensuite le résultat dans “c:\tmp\crontab.txt” à compléter avec les commandes à lancer.

Le code:

Public Sub Repartir(nTaches, nJours)
Dim nMinutes As Long
Dim dIntervalle As Long

Dim Result As String
Dim i As Integer
Dim Time As Long

If nJours > 30 Then
    MsgBox "Calcul sur 30 jours seulement", vbCritical
    Exit Sub
End If

nMinutes = nJours * 24 * 60 ' Nombre de minutes de l'intervalle
dIntervalle = Int(nMinutes / nTaches) ' Duree de l'intervalle en minutes

Debug.Print "Durée de l'intervalle: " & dIntervalle & " minutes."

Open "c:\tmp\crontab.txt" For Output As 1

Time = 0
Print #1, CronTime(Time)
Debug.Print CronTime(Time)

For i = 1 To nTaches - 1
    Time = Time + dIntervalle
    If i < 20 Then
        Debug.Print CronTime(Time)
    Else
    If i = 20 Then
        Debug.Print "etc..."
    End If
    End If
    Print #1, CronTime(Time)
Next i

Debug.Print ""
Close 1
End Sub
Public Function CronTime(Time)
Dim rHeures As Long
Dim rJours As Integer
Dim rMois As Integer
Dim sHeures As String
Dim sJours As String
Dim sMois As String
Dim nMinutes As Long

rHeures = 0
rJours = 0
rMois = 0
nMinutes = Time

While nMinutes >= 60
    nMinutes = nMinutes - 60
    rHeures = rHeures + 1
Wend

While rHeures >= 24
    rHeures = rHeures - 24
    rJours = rJours + 1
Wend

While rJours >= 30
    rJours = rJours - 30
    rMois = rMois + 1
Wend

sHeures = Str(rHeures)
sJours = Str(rJours)

If rJours = 0 Then sJours = "*" Else sJours = Str(rJours)
sMois = "*"

CronTime = nMinutes & " " & Trim(sHeures) & " " & Trim(sJours) & " " & Trim(sMois) & " *"

End Function

• La Serre: Reprise des travaux
• Bon Jovi not dead opening a restaurant will be there for me
• Titi Winterstein
• La Serre 1 – Le trou
• Display a counter and remaining time in a loop
• Truncate long path names
• Check if file exists
• Custom Autonumber Access 2000
• WeekNumber(Date)
• Replicate a database

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

• Opening an ADO recordset
• Windows 7: Désactiver l’UAC
• How can I e-mail a file from Microsoft Access?
• Create a linked table with VBA
• Custom Autonumber Access 2000
• BuildQuery()

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")

• Truncate long path names
• Create ODBC DSN
• Répartir les tâches du crontab unix
• How to convert youtube videos to mp3
• Gibson plus solide que Fender?
• How can I e-mail a file from Microsoft Access?
• Create a linked table with VBA
• Clear all line breaks
• Coordinates of the third point
• Message to log file

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

• Get Jet Connection String
• How can I e-mail a file from Microsoft Access?
• Custom Autonumber Access 2000

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

• Display a counter and remaining time in a loop
• Clear all line breaks
• Create ODBC DSN
• Relink all tables
• Répartir les tâches du crontab unix
• Gibson plus solide que Fender?
• How can I e-mail a file from Microsoft Access?
• Create a linked table with VBA
• Coordinates of the third point
• Message to log file