[VBA Word 2007] Gevraagde lid van de collectie bestaat niet* - Client software algemeen

woensdag 9 december 2009 17:10

Acties:

Verwijderd

Topicstarter

Wij hebben een Word sjabloon ontwikkeld, waarbij via VBA gegevens uit het document gebruikt worden voor de naam waaronder het document opgeslagen moet worden. Hierna moet een pop-up scherm verschijnen waarin een wachtwoord ingevoerd kan worden. Het gekke is nu dat na enkele keren gebruik na het opslaan de melding komt "5941 het gevraagde lid van de collectie bestaat niet". Het pop-up scherm voor het wachtwoord verschijnt dan niet meer. Als ik een nieuw account aanmaak in Windows en onder dat account inlog en dan voorgaande actie doe gaat het weer goed totdat na een aantal keren de melding weer verschijnt. Onderstaand de VBA code. Wie weet raad?

Visual Basic:

Option Explicit
Public myPWFlag As String
Public myNew As String

Sub subMailMergeRecipients()
'
' MailMergeRecipients Macro
' Mail Merge Recipients.

'
On Error GoTo fout

Dim ffld As FormField
Dim mmdf As MailMergeDataField


Dim oCC As ContentControl

    If myPWFlag = "TEMP" Then
    Else
        MsgBox "Het document is reeds opgeslagen. U kunt nu niet meer gebruik maken van de gegevensbron"
        Exit Sub
    End If
    
    If ActiveDocument.MailMerge.DataSource.Name = "" Then
        MsgBox "Het document heeft geen gegevensbron"
        Exit Sub
    End If


    ActiveDocument.Unprotect
    
    Dialogs(wdDialogMailMergeRecipients).Show

    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = False


        For Each mmdf In ActiveDocument.MailMerge.DataSource.DataFields
            For Each oCC In ActiveDocument.ContentControls
                If mmdf.Name = oCC.Title Then
                    Set oCC = ActiveDocument.SelectContentControlsByTitle(mmdf.Name).Item(1)
                    oCC.Range.Text = mmdf.Value
                End If
            Next oCC
        Next mmdf
        
        ActiveDocument.SelectContentControlsByTitle("Ondertekenaar").Item(1).Range.Text = _
        ActiveDocument.SelectContentControlsByTitle("Medewerker").Item(1).Range.Text
        
        Set oCC = ActiveDocument.SelectContentControlsByTitle("Rapportdatum").Item(1)
        oCC.Range.Text = Date
        Set oCC = ActiveDocument.SelectContentControlsByTitle("Branche").Item(1)
        oCC.Range.Text = "Brand Bedrijven"
        Set oCC = ActiveDocument.SelectContentControlsByTitle("Re").Item(1)
        oCC.Range.Text = "re"
        Set oCC = ActiveDocument.SelectContentControlsByTitle("Re2").Item(1)
        oCC.Range.Text = "re"


        For Each oCC In ActiveDocument.ContentControls
            If oCC.Range.Text = "Klik hier als u tekst wilt invoeren." Then
                oCC.Range.Text = " "
            End If
        Next oCC


einde:
    On Error Resume Next
    ActiveDocument.Protect Password:="", NoReset:=True, Type:= _
    wdAllowOnlyFormFields
    ActiveDocument.Sections(1).ProtectedForForms = True
    ActiveDocument.Sections(2).ProtectedForForms = False
    ActiveDocument.Sections(3).ProtectedForForms = True
    ActiveDocument.Sections(4).ProtectedForForms = False

    
    Exit Sub
    
fout:
    If Err.Number = 4605 Then
        MsgBox "Het document heeft geen gegevensbron"
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
    Resume einde


End Sub
Sub subMailMergeOpenDataSource()
'
' MailMergeOpenDataSource Macro
' Opens a data source for mail merge or insert database
On Error GoTo fout

'Dim ffld As FormField
'Dim mmdf As MailMergeDataField
Dim myFile As String
Dim myPassword As String
Dim myBron As String


'
    If myPWFlag = "TEMP" Then
        ActiveDocument.Unprotect
    Else
        MsgBox "Het document is reeds opgeslagen. U kunt niet meer gebruik maken van de gegevensbron"
        Exit Sub
'        myPassword = InputBox("Wachtwoord", "Vul een wachtwoord in")
'        ActiveDocument.Unprotect Password:=myPassword
    End If
    
If myNew = "New" Then
     'myBron = "X:\4091_GIT_MS Office Competence Center\Projecten\DLS\DSZ-225-sjablonen_expertiseinspectie\Ontwikkeling\Versie16\Map2.xls"
     myBron = "C:\synchroniseren\Map1.xls"
     Call subMerge(myBron)
     myNew = " "
Else
    myFile = fncBrowseForFile
    If myFile = "-" Then
        MsgBox "U heeft niets geselecteerd"
        GoTo einde
    End If

    Call subMerge(myFile)

End If

    
einde:
    On Error Resume Next
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = False

    ActiveDocument.Protect Password:="", NoReset:=True, Type:= _
    wdAllowOnlyFormFields
    ActiveDocument.Sections(1).ProtectedForForms = True
    ActiveDocument.Sections(2).ProtectedForForms = False
    ActiveDocument.Sections(3).ProtectedForForms = True
    ActiveDocument.Sections(4).ProtectedForForms = False

    
    Exit Sub
    
fout:
    If Err.Number = 4605 Then
        MsgBox "Het document heeft geen gegevensbron"
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
    Resume einde


End Sub

Sub subSave()
On Error GoTo fout
Dim FileName As String
Dim oCC As ContentControl

FileName = ActiveDocument.SelectContentControlsByTitle("RisicoAdresBezoekPostCode").Item(1).Range.Text & "_" & _
           ActiveDocument.SelectContentControlsByTitle("OrderNr").Item(1).Range.Text & "_" & _
           ActiveDocument.SelectContentControlsByTitle("Soort_Code").Item(1).Range.Text


With Application.Dialogs(wdDialogFileSaveAs)
    .Name = FileName
    
     If .Show = 0 Then
        MsgBox "cancel"
        Exit Sub
     End If
End With

'De volgende coderegel zorgt ervoor dat dit veld na opslaan niet meer gewijzigd kan worden)
    ActiveDocument.Unprotect
    
'    Set oCC = ActiveDocument.SelectContentControlsByTitle("Auteur").Item(1)
'    oCC.LockContents = True
    Set oCC = ActiveDocument.SelectContentControlsByTitle("OrderNr").Item(1)
    oCC.LockContents = True
    Set oCC = ActiveDocument.SelectContentControlsByTitle("polisnummer").Item(1)
    oCC.LockContents = True
    Set oCC = ActiveDocument.SelectContentControlsByTitle("OpdrKenmerk").Item(1)
    oCC.LockContents = True
    Set oCC = ActiveDocument.SelectContentControlsByTitle("opdpersVoorletters").Item(1)
    oCC.LockContents = True
    Set oCC = ActiveDocument.SelectContentControlsByTitle("opdpersTussenvoegsels").Item(1)
    oCC.LockContents = True
    Set oCC = ActiveDocument.SelectContentControlsByTitle("opdpersAchternaam").Item(1)
    oCC.LockContents = True

    Selection.EndKey Unit:=wdStory 'focus op een ander veld zetten anders gaat de beveiliging niet goed
        
    ActiveDocument.Protect Password:=InputBox("Wachtwoord", "Vul een wachtwoord in"), NoReset:=False, Type:= _
    wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=False

'Deze code zorgt ervoor dat het document een normaal document wordt. Dus geen 'mail merge'-document
ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument


'Deze code zorgt ervoor dat de koppeling met het originele sjabloon opgeheven wordt.
'Indien dit niet gebeurt wordt steeds het sjabloon gestart en krijg je de mededeling over het uitvoeren van de SQl voor de merge
'ActiveDocument.AttachedTemplate = ""


ActiveDocument.Close SaveChanges:=wdSaveChanges

einde:
    Exit Sub
fout:
    If Err.Number = 5485 Then
        MsgBox "Het document is nog met een wachtwoord beveiligd"
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
    Resume einde

End Sub
Sub subBeveiligOpheffen()
On Error GoTo fout
    If myPWFlag = "TEMP" Then
        MsgBox "Het document moet eerst opgeslagen en afgesloten worden"
    Else
        ActiveDocument.Unprotect Password:=InputBox("Wachtwoord", "Vul een wachtwoord in")
        ActiveDocument.Protect Password:="", NoReset:=True, Type:= _
            wdAllowOnlyFormFields
        ActiveDocument.Sections(1).ProtectedForForms = True
        ActiveDocument.Sections(2).ProtectedForForms = False
        ActiveDocument.Sections(3).ProtectedForForms = True
        ActiveDocument.Sections(4).ProtectedForForms = False

    End If
einde:
    Exit Sub
fout:
    If Err.Number = 5485 Then
        MsgBox "wachtwoord is onjuist"
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
    Resume einde


End Sub
Sub subMerge(invoer As String)
On Error GoTo fout
'        ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
'        ActiveDocument.MailMerge.OpenDataSource Name:= _
'        invoer _
'        , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
'        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
'        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
'        Format:=wdOpenFormatAuto, Connection:="ESPMijnOrdersMergeNAW", SQLStatement:="", _
'        SQLStatement1:="", SubType:=wdMergeSubTypeOther
        
'        With ActiveDocument.MailMerge
'        .MainDocumentType = wdCatalog
'        .OpenDataSource Name:="X:\4091_GIT_MS Office Competence Center\Projecten\DLS\DSZ-225-sjablonen_expertiseinspectie\Ontwikkeling\Versie15\Map1.xls", _
'        ReadOnly:=True, _
'        Connection:="ESPMijnOrdersMergeNAW"
'        End With

    'controle of het bestand bestaat
    If Dir(invoer) = "" Then
        MsgBox "Het bronbestand bestaat niet: " & vbCrLf & invoer & vbCrLf & " selecteer het handmatig"
    Else
    
        ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
        ActiveDocument.MailMerge.OpenDataSource Name:=invoer _
            , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
            AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
            WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
            Format:=wdOpenFormatAuto, Connection:= _
            "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=X:\4091_GIT_MS Office Competence Center\Projecten\DLS\DSZ-225-sjablonen_expertiseinspectie\Ontwikkeling\Versie16\Map1.xls;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database" _
            , SQLStatement:= _
            "SELECT * FROM `ESPMijnOrdersMergeNAW$ESPMijnOrdersMergeNAW`", _
            SQLStatement1:="", SubType:=wdMergeSubTypeAccess
    End If
    
einde:
    Exit Sub
fout:
    MsgBox Err.Number
    Resume einde

End Sub
Function fncBrowseForFile() As String

    Dim varItem As Variant
    
    fncBrowseForFile = "-"
    
    With Application.FileDialog(msoFileDialogFilePicker)
        'setup File Dialog
        .AllowMultiSelect = True
        .ButtonName = "Select"
        .InitialView = msoFileDialogViewList
        .Title = "Select Input Files"
        
        'add filter for excel
        With .Filters
            .Clear
            .Add "Excel Spreadsheets", "*.xls*"
        End With
        .FilterIndex = 1
        
        'display file dialog box

        If .Show Then
            'get selected files
            For Each varItem In .SelectedItems
'                If Not (AddListItem(lstInput, False, varItem)) Then
'                    ErrorMsgBox ("The input file (" & varItem & ") is already selected.  Try Again.")
'                End If
            fncBrowseForFile = varItem

            Next varItem
        End If
    End With
End Function

[ Voor 0% gewijzigd door Verwijderd op 10-12-2009 09:47 ]

donderdag 10 december 2009 10:06

Acties:

Verwijderd

welkom tondrift

.

dit soort van posts met "heelder lappen code" (zie Overzicht van UBB-codes #tag_code) zijn een goed voorbeeld van waarom het nodig is Het algemeen beleid #quickstart eerst eens goed door te lezen vooraleer je hier begint gaan te posten. de probleemstelling is onvoldoende duidelijk, bovendien onderneem je zelf geen poging tot diagnose.

dat gezegd zijnde is de foutmelding wel redelijk duidelijk. maar om te bepalen waar het precies aan ligt zal je de foutafhandelingstatements (on error goto fout e.d.) tijdelijk moeten uitcommentariëren tijdens het debuggen om te zien over welk lid van welke verzameling het precies gaat.
dit soort van fout doet zich voor bij het invullen van een veld (formfield) met de .range.text eigenschap terwijl het document onbeveiligd is. het gevolg is dat de waarde wel in het document geschreven wordt, maar dat het veld tevens overschreven wordt en dus niet meer bestaat. hiermee is dit lid (het net ingevulde veld) verdwenen uit de collectie.
daarnaast zijn er in de code bewerkingen op een andere collectie, de contentcontrols (nieuw blijkbaar voor word 2007). bij het aanspreken van de subcollectie van dit object pas je eveneens de .range.text-eigenschap aan, wat ook tot verwijdering van het zo aangepaste item kan leiden.

Als ik een nieuw account aanmaak in Windows en onder dat account inlog en dan voorgaande actie doe gaat het weer goed totdat na een aantal keren de melding weer verschijnt.

vergeet dit maar, het probleem stelt zich in het document zelf

Reageer