Sub Test()
''Late Binding
''Dim wrdApp As Object, wrdDoc As Object
'' Set wrdApp = CreateObject(Class:="Word.Application")
''Early Binding
Dim wrdApp As Word.Application, wrdDoc As Word.Document
Dim Taal As String, Hoofdpad As String, Zinnetje As String, Sjabloon As String
Taal = StrConv(Range("B5"), vbProperCase)
If Taal = "" Then
MsgBox "Taal ontbreekt!", vbCritical, "Vul een taal in"
Exit Sub
End If
On Error Resume Next
Set wrdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
On Error GoTo Hell
Set wrdApp = CreateObject("Word.Application")
End If
Hoofdpad = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\test\"
Sjabloon = Hoofdpad & Taal & "\intake_" & Taal & ".dotx"
wrdApp.Visible = True 'Make the application visible to the user (if wanted)
Set wrdDoc = wrdApp.Documents.Add(Template:=Sjabloon, NewTemplate:=False, DocumentType:=0)
Select Case Taal
Case "Nederlands": Zinnetje = "Dit is gemaakt vanuit Excel en komt in zicht!"
Case "Engels": Zinnetje = "This is made from Excel and comes into view!"
Case "Frans": Zinnetje = "Ceci est fabriqué à partir d'Excel et apparaît!"
End Select
With wrdDoc
.Range.InsertAfter Zinnetje
.Variables("varAchternaam").Value = Cells(1, 2)
.Variables("varVoornaam").Value = Cells(2, 2)
.Variables("varAdres").Value = " "
.Variables("varTelefoon").Value = " "
.Visible = True
.Fields.Update
.WindowState = 1
'' .Activate
End With
Exit Sub
Hell:
MsgBox "MS Excel has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: LaunchWord" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occurred!"
End Sub