[vba] err426 externe servercomputer bestaat niet beschikbaar

Pagina: 1
Acties:

Onderwerpen


Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
Met Visual basic heb ik een code geschreven om een word document te openen en daarin gegevens te plaatsen van uit een Access database.

Het openen van word werkt en de gegevens worden in word ingevuld.

Echter werkt de code maar één keer als word niet is geopend.
Als word niet is geopend werkt de code één keer. Daarna komt de melding 462.

Als word geopend blijft werkt de code prima.

Via internet vond ik enkele codes voor aan het eind van het programma. Echter deze hielpen niet.

bv;
Set appword = nothing

Mijn code:
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Compare Database
Option Explicit

Private Sub cmdWordLetter_Click()


On Error GoTo ErrorHandler

   Dim appWord As Word.Application
   Dim docs As Word.Documents
   Dim strLetter As String
   Dim prps As Object
   Dim strDate As String
   Dim fso As New Scripting.FileSystemObject
   Dim fil As Scripting.File
   Dim strTemplate As String
   Dim strTemplatePath As String
   Dim strTemplateNameAndPath As String
   Dim doc As Word.Document
   Dim strTitle As String
   Dim strPrompt As String
   
   strDate = CStr(Date)
   'Check whether template is found in the folder
   'Get User Templates path from Word Options dialog
   '(or replace with hard-coded path for your computer)
   Set appWord = GetObject(, "Word.Application")
   strTemplatePath = appWord.Options.DefaultFilePath(wdUserTemplatesPath)
   Debug.Print "Template path: " & strTemplatePath
   strTemplatePath = strTemplatePath & "\Personal Documents\"
   strLetter = "DocProps.dot"
   strTemplateNameAndPath = strTemplatePath & strLetter
   Debug.Print "Template and path: " & strTemplateNameAndPath
   
On Error Resume Next

   Set fil = fso.GetFile(strTemplateNameAndPath)
   If fil Is Nothing Then
      strPrompt = "Can't find " & strLetter & " in " _
         & strTemplatePath & "; canceling"
      MsgBox strPrompt, vbCritical + vbOKOnly
      GoTo ErrorHandlerExit
   End If
   
On Error GoTo ErrorHandler

   Set docs = appWord.Documents
   Set doc = docs.Add(strTemplateNameAndPath)
   
   Set prps = doc.CustomDocumentProperties
   
   With prps
      .Item("TodayDate").Value = strDate
      .Item("Name").Value = Nz(Me![txtFirstName] & " " & Me![txtLastName])
      .Item("Address").Value = Nz(Me![txtAddress])
      .Item("Salutation").Value = Nz(Me![txtSalutation])
      .Item("CompanyName").Value = Nz(Me![txtCompanyName])
      .Item("City").Value = Nz(Me![txtCity])
      .Item("StateProv").Value = Nz(Me![txtStateOrProvince])
      .Item("PostalCode").Value = Nz(Me![txtPostalCode])
      .Item("JobTitle").Value = Nz(Me![txtTitle])
   End With
   
   With appWord
      .Visible = True
      .Activate
      .Selection.WholeStory
      .Selection.Fields.Update
      .Selection.MoveDown Unit:=wdLine, Count:=1
   End With

ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   If Err = 429 Then
      'Word is not running; open Word with CreateObject
      Set appWord = CreateObject("Word.Application")
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
      Resume ErrorHandlerExit
   End If

End Sub

[ Voor 0% gewijzigd door Verwijderd op 02-07-2010 15:51 . Reden: codetags gebruiken aub. ]


Acties:
  • 0 Henk 'm!

Verwijderd

de foutafhandeling is onjuist geïmplementeerd : er moet niet verder gegaan worden met de code (resume next), maar er moet teruggesprongen (mbv een foutafhandelingslabel (bv. wordinstaangemaakt: )) net na het getobject(, ..) statement.
trouwens kan je beter onmiddellijk createobject gebruiken (of new word.application) en niet getobject.
bekijk ook eens Accessing Word From Inside Access

[ Voor 5% gewijzigd door Verwijderd op 02-07-2010 15:51 ]