foutmelding 1004

Status
Niet open voor verdere reacties.

so10070

Gebruiker
Lid geworden
4 feb 2014
Berichten
419
Voor elke leerkracht wordt er een Excel aangemaakt en verstuurd. Het aantal kolommen in de Excel is variabel. Dit werkt voor het eerste record, maar voor het tweede record krijg ik de foutmelding 1004: Methode Range van object _Global is mislukt. Als laatste wat ik nu gedaan heb is de Range "rng" op .clear gezet omdat ik dacht dat het adres van de Range behouden bleef. De "Lbound" en "UBound" staan telkens goed. De array "arr(i)" wordt ook goed opgehaald. Zie het probleem niet. :confused: Zie gemarkeerde in code.
Code:
                    Do While Not .EOF ' en hier Excels maken en Macro uitvoeren en E-mail versturen
                        txtStamboeknummerVersturen = !GStamboeknummer
                        txtEmailAdres = ![GE-mailadres]
        
                        sqlVersturen = "SELECT tblBasisGebruikers.GNaam AS Naam, tblBasisGebruikers.GVoornaam AS Voornaam, tblBasisGebruikers.[GE-mailadres] AS [E-mailadres], tblBasisGebruikers.[GSO-nummer] AS [SO-nummer], " & _
                            "tblBasisGebruikers.GStamboeknummer AS Stamboeknummer, tblBasisGebruikers.GInstellingsnummer AS Instellingsnummer, tblLeerlingen.[Organisatie gebruikersnaam instelling] AS Instelling, " & _
                            "tblBasisGebruikers.GLeerjaar AS Leerjaar, tblBasisGebruikers.GKlas AS KLas, tblLeerlingen.[Leerling naam] AS [Naam leerling], tblLeerlingen.[Leerling voornaam] AS [Voornaam leerling], " & _
                            sqlString & " " & _
                            "FROM tblBasisGebruikers INNER JOIN tblLeerlingen ON (tblBasisGebruikers.GKlas = tblLeerlingen.[Klas code]) AND " & _
                            "(tblBasisGebruikers.GLeerjaar = tblLeerlingen.[Opleiding leerjaar]) AND (tblBasisGebruikers.GInstellingsnummer = tblLeerlingen.[Organisatie instellingsnummer]) " & _
                            "WHERE tblBasisGebruikers.GStamboeknummer = """ & txtStamboeknummerVersturen & """ " & _
                            "ORDER BY tblLeerlingen.[Leerling naam];"
                        'Maar hier ook een QueryDef van als virtuele recordset
                        Set qryVersturen = CurrentDb.CreateQueryDef("qryTemp", sqlVersturen)

                        'Hier het aantal records tellen om het aantal rijen in Excel te kennen
                        iAantalLeerlingen = DCount("*", "qryTemp") + 1

                        'Hier Excel aanmaken
                        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qryTemp", "C:\IGEANToets_FE\TeVersturenExcels\" & txtStamboeknummerVersturen, True
        
                        'Dan Macro uitvoeren en LET OP het aantal domeinen
                        Dim iRijen As Long
                        Dim XL As Excel.Application
                        Dim OpenWerkboek As Excel.Workbook
                        Dim rng As Excel.Range
                        Dim txtRanges As String
                        Dim txtNaamKolom As String
                        Dim arr() As Variant
                        
                        Set XL = CreateObject("Excel.Application")
                        Set OpenWerkboek = XL.Workbooks.Open("C:\IGEANToets_FE\TeVersturenExcels\" & txtStamboeknummerVersturen & ".xlsx")
                        
                        txtRanges = ""
                        txtNaamKolom = "MOQSUWY" 'Let op slechts 7 domeinen maximaal toe te kennen
                        i = 1
                        
                        With XL
                            .Visible = False 'waarom False?
                            .DisplayAlerts = False
                            
                            With OpenWerkboek
                                'vanaf hier Excel formatting
                                'opletten op iAantalDomeinen!
                                'Bepaal het aantal Ranges volgens het aantal iAantalDomeinen
                                'Opnieuw de integer "i" gebruiken
                                For i = 1 To iAantalDomeinen
                                    ReDim Preserve arr(i)
                                    arr(i) = Mid(txtNaamKolom, i, 1)
                                Next i
                                
                                For i = LBound(arr) To UBound(arr)
                                    If i = LBound(arr) Then
                                        [COLOR="#FF0000"][B][U]Set rng = Range("" & arr(i) & "2:" & arr(i) & iAantalLeerlingen & "")[/U][/B][/COLOR] [COLOR="#FFFF00"][COLOR="#FF0000"]>> bij een tweede record loopt het hierop vast[/COLOR][/COLOR]
                                    Else
                                        Set rng = Union(rng, Range("" & arr(i) & "2:" & arr(i) & iAantalLeerlingen & ""))
                                    End If
                                Next i
                                
                                With rng.Validation
                                    .Delete
                                    .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=iMinPunten, Formula2:=iMaxPunten
                                    .IgnoreBlank = True
                                    .InCellDropdown = True
                                    .InputTitle = "Punten ingeven"
                                    .ErrorTitle = "Foute ingave"
                                    .InputMessage = "Geef hier je punten in."
                                    .ErrorMessage = "Geef juiste waarde in!"
                                    .ShowInput = True
                                    .ShowError = True
                                End With

                            End With
                            OpenWerkboek.Save
                        End With
                        
                        rng.Clear
                        OpenWerkboek.Close
'                        XL.Close
                        
                        Set rng = Nothing
                        Set OpenWerkboek = Nothing
                        Set XL = Nothing
                        
                        'Dan versturen
                        Dim oOutlookApp As Object
                        Dim oEmail As Object
                        
                        Set oOutlookApp = CreateObject("Outlook.Application")
                        Set oEmail = oOutlookApp.CreateItem(0)
                        
                        With oEmail
                            .To = txtEmailAdres
                            .Subject = txtEmailOnderwerp
                            .Body = txtEmailBody
                            .Attachments.Add "C:\IGEANToets_FE\TeVersturenExcels\" & txtStamboeknummerVersturen & ".xlsx"
                            .display
'                            .Send
                        End With
                    
                        'Hier EmailVerstuurd vervangen door cijfer 1
                        .Edit
                        !GEmailVerstuurd = 1
                        .Update
        
                        'Dan tijdelijke query verwijderen en op naar volgende leerkracht
                        DoCmd.DeleteObject acQuery, "qryTemp"
                        
                        'de Excels die verstuurd is naar andere map verplaatsen: "C:\IGEANToets_FE\VerstuurdeExcels"
                        Dim ofs As Object
                        
                        Set ofs = CreateObject("Scripting.FileSystemObject")
                        
                        ofs.MoveFile "C:\IGEANToets_FE\TeVersturenExcels\" & txtStamboeknummerVersturen & ".xlsx", _
                            "C:\IGEANToets_FE\VerstuurdeExcels\" & txtStamboeknummerVersturen & ".xlsx"
                        
                        Set ofs = Nothing
        
                        .MoveNext
                    Loop
 
Doe er eens een voorbeeldje bij; ik denk dat niemand staat te popelen om de db 'even' na te bouwen om te testen. De regel rng.Clear doet niet veel, omdat je een regel later de variabele al weggooit. Variabelen telkens maar weer opnieuw declareren doe ik nooit, en is in mijn ogen zinloos. Declareer ze één keer in het begin van je code, en vul ze vervolgens op het moment dat het nodig is. En gooi ze leeg als dat gevraagd wordt. Hetzelfde kan gezegd worden van het steeds opnieuw opstarten van Outlook en je FileSystemObject: nutteloos en nodeloos vertragend.
 
Hierbij een voorbeeld. Let wel: het wegschrijven gebeurt naar twee mappen "C:\IGEANToets_FE\TeVersturenExcels" en "C:\IGEANToets_FE\VerstuurdeExcels". Op het formulier gaat het enkel over de knop "Versturen".
 

Bijlagen

  • IGEANtoets.rar
    68,4 KB · Weergaven: 20
Heb de fout gevonden: Had dezelfde numerieke waarde op twee verschillende plaatsen voor twee verschillende doeleinden in de procedure gebruikt en had deze waarde slechts één maal gedeclareerd. Heb er nu twee waarden van gemaakt en het probleem deed zich niet meer voor.
Heb ook alle declaraties en opstarten van Outlook, enz. bovenaan de procedure gezet. Wel overzichtelijker en performanter. Weer nieuwe zaken bijgeleerd! :thumb: :D
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan