Transferspreadsheet vind tabel soms niet

[so10070]

De functie "If ObjectBestaatNog" vindt de FE-tabel in de collectie maar de code "DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, ![Organisatie instellingsnummer], txtMapFileNaam, True" geeft een fout op de tabel. Die schijnt niet gevonden te zijn. En soms doet deze code het wel voor 1 of 2 tabellen. Weet niet wat hier aan de hand is?

En als ik in het directvenster ![Organisatie instellingsnummer] intyp geeft die soms wel het nummer soms niet, maar wel met rst1!![Organisatie instellingsnummer].

Ook reeds geprobeerd om het nummer van een school zelf in het Docmd-commando in te typen, maar zonder resultaat.

Dit is de code.

Private Sub butMailsVersturen_Click()
    Dim cnn As ADODB.Connection
    Dim rst1 As New ADODB.Recordset 'tblDirecties
    Dim oExcel As Excel.Application
    Dim oTabblad1 As Worksheet
    Dim oWerkboek1 As Workbook
    Dim oOL As Outlook.Application 'early binding
    Dim oEmail As Outlook.MailItem 'early binding
    Dim txtEmailAdres As String
    Dim txtEmailOnderwerp As String
    Dim txtEmailBody As String
    Dim txtMapFileNaam As String
    Dim txtMapNaam As String
    Dim txtHandleidingFileNaam As String
    Dim txtRapportPerLeerlingFileNaam As String
    Dim sqlScholenRapportenMailen As String
    Dim iLaatsteKolom As Integer
    Dim iLaatsteRij As Integer
    Dim TabelBestaat As Boolean
    Dim strCodeModule As String
    
    strCodeModule = "frmMailsRapporten butMailsVersturen_Click()"
    
    On Error GoTo foutafhandeling

    Set oOL = New Outlook.Application ' early binding
    Set oExcel = CreateObject("Excel.Application")
    
    txtMapNaam = DLookup("NaarDirecteur_Rapporten", "tblSysteemSettings") 'Plaatsen Excels
    txtRapportPerLeerlingFileNaam = txtMapNaam & "\RapportPerLeerlingOVSGToets.docx"
    txtHandleidingFileNaam = txtMapNaam & "\Handleiding.docx"
    
    sqlScholenRapportenMailen = "SELECT [Organisatie instellingsnummer], [Organisatie gebruikersnaam instelling], " & _
        "[Organisatie naam directeur instelling], [Gebruikte voornaam], [Personeel e-mail], VerstuurdRapporten " & _
        "FROM tblDirecties " & _
        "WHERE VerstuurdRapporten = True " & _
        "ORDER BY [Organisatie instellingsnummer];"
    
    Set cnn = CurrentProject.Connection
    rst1.Open sqlScholenRapportenMailen, cnn, adOpenKeyset, adLockPessimistic
    
    rst1.MoveLast 'populeren
    rst1.MoveFirst
    
    With rst1
        Do While Not .EOF
            txtMapFileNaam = txtMapNaam & "\" & ![Organisatie instellingsnummer] & ".xlsx"
            
            'Contreleren of tabel ![Organisatie instellingsnummer] bestaat
            If ObjectBestaatNog(![Organisatie instellingsnummer], 1) = False Then
                'hier niets, naar volgende record in rst1
            Else
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, [COLOR="#FF0000"][B][U]![Organisatie instellingsnummer][/U][/B][/COLOR], txtMapFileNaam, True
                
                'Hier tabel verwijderen
                DoCmd.DeleteObject acTable, ![Organisatie instellingsnummer]
                
                Set oWerkboek1 = oExcel.Workbooks.Open(txtMapFileNaam)
                Set oTabblad1 = oWerkboek1.Worksheets("_" & ![Organisatie instellingsnummer])
    
                'Vind eerst de laatste kolom en laatste rij en pas format aan
                iLaatsteKolom = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column
                iLaatsteRij = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
                Range(Cells(2, iLaatsteKolom), Cells(iLaatsteRij, iLaatsteKolom)).NumberFormat = "00.0"
                Range(Cells(2, iLaatsteKolom - 1), Cells(iLaatsteRij, iLaatsteKolom - 1)).NumberFormat = "00.0"
                Range(Cells(2, iLaatsteKolom - 2), Cells(iLaatsteRij, iLaatsteKolom - 2)).NumberFormat = "00.0"
                Range(Cells(2, iLaatsteKolom - 3), Cells(iLaatsteRij, iLaatsteKolom - 3)).NumberFormat = "00.0"
    
                'Dan versturen
                Set oEmail = oOL.CreateItem(olMailItem)
    
                txtEmailAdres = ![Personeel e-mail]
                txtEmailOnderwerp = DLookup("MRapportenOnderwerp", "tblMail")
                txtEmailBody = DLookup("MRapportenTekst", "tblMail")
    
                With oEmail
                    .To = rst1![Personeel e-mail]
                    .Subject = txtEmailOnderwerp
                    .Body = txtEmailBody
                    .Attachments.Add txtMapFileNaam
                    .Attachments.Add txtHandleidingFileNaam
                    .Attachments.Add txtRapportPerLeerlingFileNaam
                    .Display
                    '.Send
                End With
            End If
            .MoveNext
        Loop
    End With
    
    rst1.Close
    Set rst1 = Nothing
    Set cnn = Nothinf
    Set oWerkboek1 = Nothing
    Set oTabblad1 = Nothing
    Set oExcel = Nothing
    Set oEmail = Nothing
    Set oOL = Nothing
    
Exit_Sub:
    Exit Sub
    
foutafhandeling:
    Call FoutenRegistratie(Err.Number, Err.Description, strCodeModule, Environ("Username"))
    Resume Exit_Sub
End Sub

 

[OctaFish]

Twee uitroeptekens achter rst? Dat zou zeker niet mogen werken...

 

[so10070]

Ja, is een typefout in deze vraag, maar niet in de code

 

[OctaFish]

Zit er wellicht een spatie in de tabel naam? Dan gaat het op zeker niet werken zo.

 

[so10070]

Neen, is een nummer als string: bijvoorbeeld 006578, enz. Maar hen de table naam ook gewijzigd de reële naam, nl. 006578 en ook dat gaf de foutmelding.

 

[so10070]

Eigen stommiteit: elk werkboek wordt geopend maar niet gesloten

Openen

                Set oWerkboek1 = oExcel.Workbooks.Open(txtMapFileNaam)
                Set oTabblad1 = oWerkboek1.Worksheets("_" & ![Organisatie instellingsnummer])

Sluiten

                oWerkboek1.Close SaveChanges:=True
                Set oWerkboek1 = Nothing

Heb dit aangepast en dit onderdeel werkt nu!