het vet gedrukte deel geeft hij dus aan dat deze fout word gemaakt
de insteek is dat deze code zoekt naar email adressen en deze dan een rapport mailt met daarop een filter .
dus via filter zoekt hij de email adressen bij de werknemers .
de insteek is dat deze code zoekt naar email adressen en deze dan een rapport mailt met daarop een filter .
dus via filter zoekt hij de email adressen bij de werknemers .
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])
[B]DoCmd.SendObject acSendReport, "RptPlanning", acFormatPDF, Me.Email, , , , Me.Werknemer,[/B] True
.MoveNext
Next
End If
.Close
End With
End Sub
Laatst bewerkt: