Leo,
Ik ben een leek in dit soort dingen, was denk ik al duidelijk. Heb je oplossing in de bestaande macro verwerkt, maar heb het sterke vermoeden dat ik algemene basiskennis mis voor dit soort dingen.
Heb daarom maar even de hele macro ingekopieerd, wellicht zie je kans om er even naar te kijken en (opbouwend) commentaar over te geven.
het toegevoegde gedeelte is helemaal onderaan.
Is trouwens "formulier" beveiliging iets anders dan "algemeen" een doument beveiligen?
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Const DEBUGMODE = False
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
Const DELETE = &H10000
Const WRITE_DAC = &H40000
Const WRITE_OWNER = &H80000
Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const SPECIFIC_RIGHTS_ALL = &HFFFF
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Const WORDEXPORT_TXT = "wordexp.doc"
Sub Document_New()
Dim sValue As String
Dim sRegKey As String
Dim sFile As String
Dim nKey As Long
Dim nType As Long
Dim nLength As Long
Dim bOk As Boolean
Dim sDoc As String
Dim sErrorLog As String
On Error GoTo fout
If DEBUGMODE = True Then
MsgBox "Deze macro staat in DEBUG mode. Aan het einde van deze macro zal gemeld worden of de uitvoering goed is gegaan." & vbCrLf & _
"DIT SJABLOON IS NIET GESCHIKT VOOR UITLEVERING !" & vbCrLf & _
"(Deze boodschap wordt alleen getoond in testversies van WORDEXPORT)", vbOKOnly + vbInformation, "DEBUG"
End If
' === INITIALISATIE ===
sRegKey = "Software\ScabKpd\Install"
sValue = "Path"
nLength = 99999
bOk = True
sDoc = ActiveDocument.Name
sErrorLog = ""
' === De registry uitlezen voor het pad ===
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, sRegKey, 0, KEY_READ, nKey) = 0 Then
' Zet de buffer op NULL
sFile = String$(nLength, " ")
' Haal de buffergroote (nLength) op
If RegQueryValueEx(nKey, sValue, 0, nType, sFile, nLength) = 0 Then
' Stel de buffer in
sFile = String$(nLength - 1, " ")
' Haal de bestandsnaam op
If RegQueryValueEx(nKey, sValue, 0, nType, sFile, nLength) <> 0 Then
sErrorLog = sErrorLog & "RegQueryValueEx (Fetch)" & vbCrLf
End If
' Is er een fout opgetreden ??
If sFile = "" Then bOk = False
Else
bOk = False
sErrorLog = sErrorLog & "RegQueryValueEx (Buffer)" & vbCrLf
End If
' Sluit de handle
Call RegCloseKey(nKey)
Else
'bOk = False
sErrorLog = sErrorLog & "RegOpenKeyEx" & vbCrLf
End If
' Als er geen pad wordt gevonden in de registry dan C:\ nemen
If bOk = True And sFile = "" Then
sFile = "C:\"
End If
' Controeren of het laatste teken wel een \ is
If Right$(sFile, 1) <> "\" Then sFile = sFile & "\"
' De bestandsnaam er aan plakken
sFile = sFile & WORDEXPORT_TXT
' Controleren of het bestand bestaat
If Dir(sFile) = "" Then
Call MsgBox("Het samenvoegbestand " & vbCrLf & _
sFile & vbCrLf & _
"bestaat niet. Controleer de mailing-module.", vbOKOnly + vbCritical, "Samenvoegen")
bOk = False
sErrorLog = sErrorLog & "Dir(sFile)=''" & vbCrLf
End If
' === Het samenvoegen starten ===
If bOk = True Then
With ActiveDocument.MailMerge
.OpenDataSource sFile
'.Destination = wdSendToPrinter
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
.Execute
End With
' Het bestand sluiten (zonder op te slaan)
Documents(sDoc).Close False
End If
If DEBUGMODE = True Then
If bOk = True Then
MsgBox "Er zijn geen fouten opgetreden tijdens het uitvoeren van deze macro." & vbCrLf & _
"(Deze boodschap wordt alleen getoond in testversies van WORDEXPORT)", vbOKOnly + vbInformation, "DEBUG MODE"
Else
MsgBox "Op de volgende regel is er een fout opgetreden " & vbCrLf & sErrorLog & vbCrLf & _
"(Deze boodschap wordt alleen getoond in testversies van WORDEXPORT)", vbOKOnly + vbInformation, "DEBUG MODE"
End If
End If
End
ActiveDocument.Protect ("piet")
End
fout:
bOk = False
sErrorLog = sErrorLog & "ON ERROR (" & Err.Source & "/" & Err.Description & ")" & vbCrLf
End Sub
