Vba
In Outlook :
Sub Check_test()
Dim LPath As String
Dim LCategoryID As Long
Dim oapp As Object
LPath = path\DB_BE.accdb"
Set oapp = CreateObject("Access.Application")
On Error Resume Next
oapp.Visible = False
On Error Resume Next
oapp.OpenCurrentDatabase LPath, False
oapp.Run "check"
Set oapp = Nothing
End Sub
In Access :
Public Sub check()
Dim strsql As String
Dim db As DAO.Database, rs As DAO.Recordset
Dim DayB As Date, DayL As Date, datum As Date
Dim strmsg As String
DayB = FirstDayInMonth
DayL = LastDayInMonth
strsql = "SELECT datum, Sum(1) AS Aantal FROM tabel "
strsql = strsql & "GROUP BY datum, code "
strsql = strsql & "HAVING datum >= " & Chr(35) & DayB & Chr(35) & " and "
strsql = strsql & "datum < " & Chr(35) & DayL & Chr(35) & " and "
strsql = strsql & "code = 1 ;"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strsql, dbOpenDynaset)
With rs
If .RecordCount = 0 Then
MsgBox "Er zijn voor de periode " & DayB & " - " & DayL & " geen records beschikbaar.", vbInformation
GoTo einde
Else
.MoveLast
If .RecordCount > 1 Then
.MoveFirst
strmsg = ""
Do Until .EOF
If !aantal > 1 Then
strmsg = strmsg & "Er zijn voor " & ! datum & ", " & !aantal & " records beschikbaar." & vbCrLf
Else
strmsg = strmsg & "Er zijn voor " & ! datum & ", " & !aantal & " record beschikbaar." & vbCrLf
End If
.MoveNext
Loop
MsgBox strmsg, vbInformation
Else
If !aantal > 1 Then
MsgBox "Er zijn voor " & ! datum & ", " & !aantal & " records beschikbaar.", vbInformation
Else
MsgBox "Er zijn voor " & ! datum & ", " & !aantal & " record beschikbaar.", vbInformation
End If
End If
GoTo einde
End If
End With
einde:
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub
Public Function FirstDayInMonth(Optional iDate As Variant) As Date
If IsMissing(iDate) Then
iDate = Date
End If
FirstDayInMonth = DateSerial(Year(iDate), Month(iDate), 1)
End Function
Public Function LastDayInMonth(Optional iDate As Variant) As Date
If IsMissing(iDate) Then
iDate = Date
End If
LastDayInMonth = DateSerial(Year(iDate), Month(iDate) + 1, 0)
End Function
