code
Private Sub Test_Click()
Dim strSQL As String, strSQL_Rapport As String
Dim sTabel As String, sRapport As String, iAantal As String
Dim X As Integer
Dim strwhere As String
strSQL = "SELECT * FROM qryPlanning"
sRapport = "rptPlanning"
DoCmd.Echo False, "Bezig met openen van recordset."
With CurrentDb.OpenRecordset(strSQL)
.MoveLast
.MoveFirst
iAantal = .RecordCount
If iAantal > 0 Then
For X = 1 To iAantal
strwhere = strwhere & "([Werknemer] = " & Me.CboWerknemer & ").Value"
DoCmd.Echo False, "Samenvoegen van Record " & X & " van " & iAantal & " records..."
DoCmd.OpenReport sRapport, acViewDesign, , , acHidden
sTabel = Reports(sRapport).RecordSource
If InStr(1, UCase(sTabel), "WHERE") > 0 Then
strSQL_Rapport = Left(sTabel, InStr(1, sTabel, "WHERE ") - 1)
Else
If InStr(1, UCase(sTabel), "SELECT") = 0 Then
If InStr(1, sTabel, " ") > 0 And InStr(1, sTabel, "[") = 0 Then
sTabel = "[" & sTabel & "]"
End If
strSQL_Rapport = "SELECT * FROM " & sTabel & " "
Else
strSQL_Rapport = sTabel
End If
End If
Do Until Right(strSQL_Rapport, 1) <> ";"
strSQL = Left(strSQL_Rapport, Len(strSQL_Rapport) - 1)
Loop
strSQL_Rapport = strSQL_Rapport & Me.Filter
Reports(sRapport).RecordSource = strSQL_Rapport
DoCmd.Close acReport, sRapport, acSaveYes
Me.Email = DLookup("email", "tblpersoneel", "PersoneelNR=" & [Werknemer])
DoCmd.SendObject acSendReport, "RptPlanning", acFormatPDF, Me.Email, , , , Me.Werknemer, True
.MoveNext
Next
End If
.Close
End With
End Sub
/code