krijg een fout melding en weet niet waarom

[dinoshop]

Private Sub Mail_Click()
Dim Email As String, FileName As String, Filepath As String
Dim strSQL As String
Dim rs As Recordset
Dim qTmp As QueryDef
Dim folder As String
Dim strDocName As String
Dim strWhere As String
''Dim tmp As String
Me.Dirty = False
 On Error GoTo Err_mail_click
   
    strSQL = "SELECT * FROM QryPlanningmail WHERE [projectid] = " & Me.CboProjectNR & " Order by Email"
    Set qTmp = CurrentDb.QueryDefs("TmpPlanning")
        qTmp.SQL = strSQL
    ''tmp = InputBox("", "", strSQL)
     strSQL = "SELECT * FROM TmpPlanning WHERE ([Email] Is Not Null And Not [Email] = """")"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    If rs.RecordCount > 0 Then
       Do Until rs.EOF
            If Not Email = vbNullString Then Email = Email & ";"
            Email = Email & rs!Email
            rs.MoveNext
        Loop
    Else
        MsgBox "Geen email adressen..."
        Exit Sub
   End If
 Me.ProjectID.Requery
DoCmd.OpenReport "RpTPlanning", acViewPreview, , Me.Filter, acHidden
DoCmd.SendObject acSendReport, "RptPlanning", acFormatPDF, Email, , , "Planning", True
DoCmd.Close acReport, "RptPlanning"
Err_mail_click:
    MsgBox Err.Description
 If Len(Verzonden) = 0 Then
Verzonden.Value = False
Else
Verzonden.Value = True
 End If
 folder = CurrentProject.Path & "\VerzondenMail\"
 MkDir folder
 Resume Mail
Mail:
strDocName = "Planning"
strWhere = "[projectid]=" & Me.Filter
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, folder & Me.Filter & ".PDF"
DoCmd.Close acReport, strDocName
err_mail:
    MsgBox Err.Description
End Sub

bij de MkDir folder wordt die geel ga ik er opstaan geeft die het goede pad wel aan.

 

[edmoor]

Als je zegt een foutmelding te krijgen is het ook handig deze er hier bij te vermelden.
Laat ook zien hoe het pad er dan uitziet.

 

[OctaFish]

Je gebruikt volgens mij 2 technieken door elkaar: enerzijds gebruik je een aangepaste querydef, anderzijds een filter op het rapport. Eén van de 2 moet weg.
dus ofwel je rapport baseren op

     Set qTmp = CurrentDb.QueryDefs("TmpPlanning")

ofwel

     DoCmd.OpenReport "RpTPlanning", acViewPreview, , Me.Filter, acHidden

 

[OctaFish]

Overigens loop je altijd door naar de Err afhandeling:

    DoCmd.Close acReport, "RptPlanning"

Err_mail_click:

Er zit geen Goto Mail of Exit Sub tussen, dus na het sluiten van het rapport (is dus niet nodig als je de QueryDef variant gebruikt) ga je nu altijd naar Err_mail_click.

 

[OctaFish]

bij de MkDir folder wordt die geel ga ik er opstaan geeft die het goede pad wel aan.

Een map mag maar één keer aangemaakt worden. Ligt daar je probleem niet?

 

[dinoshop]

veel info ga er na kijken

 

[dinoshop]

heb hem aangepast het eerste deel zoekt email adressen en verzend deze perfect werkend.
geeft verder geen fouten meer aan alleen opslaan doet die niet en dat zou toch moeten denk ik zo of vergeet ik iets .

Private Sub Mail_Click()
Dim Email As String, FileName As String, Filepath As String
Dim strSQL As String
Dim rs As Recordset
Dim qTmp As QueryDef
Dim Folder As String
Dim strDocName As String
Dim strWhere As String
''Dim tmp As String
Me.Dirty = False
strDocName = "RptPlanning"
strWhere = "[projectid]=" & Me.Filter
 On Error GoTo Err_mail_click
   
    strSQL = "SELECT * FROM QryPlanningmail WHERE [projectid] = " & Me.CboProjectNR & " Order by Email"
    Set qTmp = CurrentDb.QueryDefs("TmpPlanning")
        qTmp.SQL = strSQL
    ''tmp = InputBox("", "", strSQL)
     strSQL = "SELECT * FROM TmpPlanning WHERE ([Email] Is Not Null And Not [Email] = """")"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    If rs.RecordCount > 0 Then
       Do Until rs.EOF
            If Not Email = vbNullString Then Email = Email & ";"
            Email = Email & rs!Email
            rs.MoveNext
        Loop
    Else
        MsgBox "Geen email adressen..."
        Exit Sub
   End If
 Me.ProjectID.Requery


DoCmd.OpenReport strDocName, acViewPreview, , Me.Filter, acHidden
DoCmd.SendObject acSendReport, strDocName, acFormatPDF, Email, , , "Planning", True
Folder = CurrentProject.Path & "\VerzondenMail\"
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, Folder & Me.Filter & ".PDF"




DoCmd.Close acReport, strDocName
Err_mail_click:
    MsgBox Err.Description
 If Len(Verzonden) = 0 Then
Verzonden.Value = False
Else
Verzonden.Value = True
 End If
 
 

err_mail:
    MsgBox Err.Description
End Sub