Formularschutz per Code aufheben

DrMueller

Erfahrenes Mitglied
Hallo Leute mal wieder,
erst mal: Ich arbeite mit VB6, darum schreibe ich mal in diesem Forum. Da es sich aber eher um ein office-Problem handetl, kann es auch gut sein, dass ich hier falsch bin.
Zu meinem eigentlichen Problem:
Das Programm soll zwei Dokumente überprüfen und dem Benutzer die Unterschiede anzeigen.
Soweit kein Problem, es gibt ja
Code:
wd.ActiveDocument.compare
mit dem ich zwei Dokumente überprüfen.
Ich habe es ebenfalls schon geschafft, dass die Dokumente, falls sie Passwort geschützt sind, mittels Eingabe des Passworts überprüft werden.

Nun habe ich aber das problem, dass teilw. auch noch der Formular-Schutz drauf ist. Ich wollte es mir einfach machen: Makro-Aufzeichnung an Dokumentschutz draufklatschen/wegnehmen und gut ist. Leider klappt das nicht, da das Makro bei diesen Befehlen stoppt.
Auch im Inet finde ich praktisch nur Dinge über den Dokumenten-Schutz aber nicht über den Formular-Schutz.

Hat mir da jemand eine kleine Hilfe, wie man diesen wegbringt?
 
Deutsch | Englisch
--------------------------
schützen | to protect

;)

Wie wärs da mit
Visual Basic:
'Schützen
ActiveDocument.Protect

'Schutz aufheben
ActiveDocument.Unprotect


Der Doc!
 
Ich bin ein Depp, das Problem war an einem anderen Ort. Hab mich da bisschen auf was eingeschossen, danke nochmal.
Lustigerweise habe ich ein neues Problem:
Ich vergleiche zwei Dokumente, welche Formularfelder mit Werten dirn hatten, nun erscheinen diese Formularfelder immer leer, nachdem ich sie verglichen habe.
Ich hab mal ein Bild gemacht, wie das am Ende aussieht, ka wie das möglich ist.

Jemand schon mal so einen Fall erlebt?

Im Bild sind drei Dokumente: V1 und V2 sind die beiden zu verlgeichenden Dokumente, das "Neue Dokument" ist das Vergleichs-Dokument.
 

Anhänge

  • vergleich.jpg
    vergleich.jpg
    45,8 KB · Aufrufe: 56
hm ist natürlich relativ grob in unser programm eingemauert, aber hier die Funktion.

Code:
Public Function CompareDocuments(MainDoc As String, OldDoc As String, lAktID As Long, lMainDocVersion As Long, lOldDocVersion As Long) As Boolean  'mm 17.06.2009 - 1512795 Start
  'uses the comparison-function of Word to display the difference
  'between two documents
  'XtremeDebug "In  " & App.EXEName & " CompareDocuments in Prog "     'MLHIDE

  On Error Resume Next
  
  'mm 18.06.2009 - 1512795 Start
  Dim fDocPWForm As frmDocPW
  Dim i As Integer
  Dim sActiveDoc As String
  Dim t As C4DocH.clsDocHnd
  Dim sWorkFile As String
  Dim tmpPath As String
  Dim cfc As ConsFunction
  Dim sOldFile
  'mm 18.06.2009 - 1512795 Ende
  Dim lFormSchutz As Long 'mm 19.08.2009 - 1530842
  
  lFormSchutz = 0 'mm 19.08.2009 - 1530842
  
  If Len(MainDoc) > False And Len(OldDoc) > False Then
    If FilesExtension(MainDoc) <> FilesExtension(OldDoc) Then
      MsgBox ml_string(4004, "Es können nur Dokumente gleichen Typs verglichen werden."), vbOKOnly + vbInformation, ml_string(979, "Hinweis")
      CompareDocuments = True
    Else
      Select Case LCase$(FilesExtension(MainDoc))
        Case "docx", "doc", "htm", "rtf", "txt", "html"                      'MLHIDE
          If FilesExists(MainDoc) And FilesExists(OldDoc) Then
            CompareDocuments = True  'Voraussetzungen gegeben
                        
            'hj 30.01.2009 - 1489457 - wdx auf wd geändert
            'Dim wdx As Object
            
            'mu 12.12.2008 - 1478407
            'Call GetWordObject 'hj 24.11.2003 damit ConsSettings.WordVersion gefüllt wird
            Call GetWordObject(, , , False) 'hj 24.11.2003 damit ConsSettings.WordVersion gefüllt wird
            
            'Set wdx = CreateObject("Word.Application")                  'hj 30.01.2009 - 1489457     'MLHIDE
            If Err = False Then
              'hj 30.01.2009 - 1489457
              'mm 17.06.2009 - 1512795 Start
              Set t = New C4DocH.clsDocHnd
              Set t.Rep = GRep
              Set cfc = New ConsFunction
              tmpPath = cfc.GetTempPath & "Cns\CnsWork\readonly"
     
              For i = 1 To 2
                If i = 2 Then
                  sActiveDoc = MainDoc
                  sWorkFile = getDocNameWithoutPath(sActiveDoc)
                  sWorkFile = tmpPath & "\" & sWorkFile & "_tmp"
                  Call t.checkOut(True, lAktID, 0, lMainDocVersion, MainDoc, False)
                  Call FileCopy(MainDoc, sWorkFile)
                  FilesMakeWritable sWorkFile
                Else
                  sActiveDoc = OldDoc
                  sWorkFile = getDocNameWithoutPath(sActiveDoc)
                  sWorkFile = tmpPath & "\" & sWorkFile & "_tmp"
                  Call t.checkOut(True, lAktID, 0, lOldDocVersion, OldDoc, False)
                  Call FileCopy(OldDoc, sWorkFile)
                  FilesMakeWritable sWorkFile
                  sOldFile = sWorkFile
                End If

                Call wd.Documents.Open(sWorkFile, False, True, False)
                'mm 19.08.2009 - 1530842 Start
                If wd.ActiveDocument.protectiontype = 2 Then
                  lFormSchutz = lFormSchutz + 1
                End If
                'mm 19.08.2009 - 1530842 Ende
                If wd.ActiveDocument.protectiontype <> -1 Then  'mm -1 = wdNoProtection
                  If Len(wd.ActiveDocument.unprotect) > 0 Then 'mm: Falls Fehler auftritt, wird dieser direkt zurückgegeben
                    WriteDBGView "Fehler beim Entsichern des des Dokumentes. Fehler: " & Err.Description, App.EXEName
enter_password:
                    Set fDocPWForm = New frmDocPW
                    Load fDocPWForm
                    fDocPWForm.dokumentName = getDocNameWithoutPath(sActiveDoc)
                    fDocPWForm.Show vbModal

                    If fDocPWForm.Cancel = False Then
                      If Len(wd.ActiveDocument.unprotect(Password:=fDocPWForm.passwort)) > 0 Then
                        MsgBox ml_string(5115, "Das Dokument konnte mit diesem Passwort nicht entsichert werden."), vbExclamation, ml_string(979, "Hinweis")
                        GoTo enter_password
                      Else
                        Call wd.ActiveDocument.SaveAs(sWorkFile & "_tmp")
                        Call wd.ActiveDocument.Close
                        Call DeleteFile(sWorkFile)
                        Call FileCopy(sWorkFile & "_tmp", sWorkFile)
                        Call DeleteFile(sWorkFile & "_tmp")
                      End If
                    Else
                      Exit Function
                    End If
                  Else
                  'mm 19.08.2009 - 1530842 Start
                  Call wd.ActiveDocument.SaveAs(sWorkFile & "_tmp")
                  Call wd.ActiveDocument.Close
                  Call DeleteFile(sWorkFile)
                  Call FileCopy(sWorkFile & "_tmp", sWorkFile)
                  Call DeleteFile(sWorkFile & "_tmp")
                  'mm 19.08.2009 - 1530842 Ende
                  End If
                End If
                wd.Documents(sWorkFile).Close False
              Next i

              wd.Visible = False 'mm 19.08.2009 - 1530842
              Call wd.Documents.Open(sWorkFile, False, True, False)
              wd.ActiveDocument.compare sOldFile
'              wd.activedocument.Compare (OldDoc)
              'mm 17.06.2009 - 1512795 Ende
              
              'mm 19.08.2009 - 1530842 Start
              If lFormSchutz = 2 Then  'Formularschutz
                wd.ActiveDocument.Protect Type:=2
                wd.ActiveDocument.Close wd.WdSaveOptions.wdSaveChanges
              End If
              'mm 19.08.2009 - 1530842 Ende
              
              If CByte(Replace(ConsSettings.WordVers, ".", ",")) > 9 Then   'MLHIDE
                'mm 17.06.2009 - 1512795 Start
                wd.Documents(sWorkFile).Close False
                'wd.Documents(MainDoc).Close False  'cb 25.6.2003 - sonst ist unter XP 2mal Word offen !!
                'mm 17.06.2009 - 1512795 Ende
              End If
              wd.Visible = True
            Else
              MsgBox Err.Number & " " & Err.Description, vbOKOnly + vbInformation, ml_string(971, "Fehler") 'MLHIDE
            End If
            'mu 12.12.2008 - 1478407
            'Set wdx = Nothing
          Else
            MsgBox ml_string(3379, "Fehler beim Dateizugriff!"), vbOKOnly + vbInformation, ml_string(979, "Hinweis")
          End If
        Case Else
          MsgBox ml_string(4005, "Für diesen Dokumententyp ist kein Versionsvergleich möglich."), vbOKOnly + vbInformation, ml_string(979, "Hinweis")
          CompareDocuments = True
      End Select
    End If
  End If
  'XtremeDebug "OUT " & App.EXEName & " CompareDocuments in Prog "     'MLHIDE
End Function

Wie gesagt, noch nicht final, da ich immer noch am dranbasteln bin.
Klappt alles, entsichern, sichern, Vergleichen nur eben das die Feld-Inhalte gelöscht werden.
 
Zurück