Private Sub KnopWordlijst_Click()
Dim strbestnaam As String
Dim persoonlijkeDir As String
Dim ObjWrd As Word.Application
Dim objWDoc As Word.Document
Dim objWrange As Word.Range
Dim oCtl As Access.Control
Dim WordRunning As Boolean
Dim fileexist As Boolean
Dim IANTWOORD As Integer
Dim BasisDirectory As String
Dim strDirectory As String
On Error GoTo errorhandler
BasisDirectory = Application.CurrentProject.path
strDirectory = Left$(CurrentProject.path, InStrRev(CurrentProject.path, "\"))
persoonlijkeDir = strDirectory & "DOSSIERS\" & Me.Persoonssleutel & "\"
strbestnaam = persoonlijkeDir & "Onderzoek" & ".doc"
If Len(Dir(strbestnaam, vbNormal)) <> 0 Then
IANTWOORD = MSgbox("LIJST ONDERZOEK BESTAAT REEDS !" _
& vbCr & vbCr & "OPNIEUW SAMENSTELLEN ?" _
& vbCr, vbYesNoCancel, "MAAK EEN KEUZE")
Select Case IANTWOORD
Case vbYes
fileexist = False
Case vbNo
fileexist = True
Case vbCancel
Exit Sub
End Select
End If
If Not fFolderBestaat(strDirectory) Then fMaakFolder (strDirectory)
If Not fFolderBestaat(persoonlijkeDir) Then fMaakFolder (persoonlijkeDir)
Set ObjWrd = GetObject(, "Word.Application")
If fileexist = True Then
ObjWrd.Visible = True 'Toon de word-applicatie
ObjWrd.Documents.Open (strbestnaam) 'Open het bestand
ObjWrd.Activate 'Activeer Word met het geopende bestand
Else
Set objWDoc = ObjWrd.Documents.Add(strDirectory & "formulieren\Onderzoek.dot")
With ObjWrd
.ScreenUpdating = False
With objWDoc
Set objWrange = .GoTo(What:=wdGoToBookmark, Name:="A")
If Format(Forms![KVB]!Datumcontact.Value) = "" Then objWrange.Text = "N.v.T" Else objWrange.Text = Format(Forms![KVB]!Datumcontact.Value, "dddd dd mmmm yyyy") & " om " & Format([Forms]![KVB]!Tijdcontact.Value, "hh:mm") & " uur."
"etc, etc,
.SaveAs FileName:=strbestnaam, FileFormat:=wdFormatDocument
End With
MSgbox "Het bestand is opgeslagen in:" & vbCr & _
persoonlijkeDir & vbCr & vbCr & "De bestandsnaam is: " & vbCr & _
Left(strbestnaam, Len(strbestnaam) - 4), vbInformation, "Bevestiging van opslaan"
End With
End If
With ObjWrd
.Visible = True
.WindowState = wdWindowStateMaximize
.ScreenRefresh
.ScreenUpdating = True
.Browser.Target = wdBrowsePage
.Activate
' DoCmd.Close
End With
AppActivate "Microsoft Word" 'Zorgt ervoor dat het document niet op de taakbalk blijft staan.
Errorhandlerexit:
Set ObjWrd = Nothing
Set objWDoc = Nothing
Set objWrange = Nothing
Set oCtl = Nothing
Exit Sub
errorhandler:
If err.Number = 429 Then
Set ObjWrd = CreateObject("Word.Application")
Resume Next
Else
MSgbox "Error No: " & err.Number & "; Description: " & err.Description
Resume Errorhandlerexit
Set ObjWrd = CreateObject("Word.Application")
Resume Next
End If
End Sub