2017-12-01 92 views
0

これは既に公開されているいくつかの問題と類似しています。私は他の質問に答えを適用する方法を知らないので、私は具体的な助けが必要です。VBA Wordリモートサーバーマシンが存在しないか、利用できません。

基本的に、私はMSWordのを参照するAccessでコードを書いている、と私は、コードを複数回実行した場合、それがリモートサーバーマシンが

を存在しないか、使用できる状態ではありませんメッセージ

で失敗を開始ここで

はコードです:

Private Sub CreateWordMergeDoc_Click() 

On Error GoTo Err_CreateWordMergeDoc_Click 

Dim strSQL, strChurch, strDistLang, strFind, strReplace As String 
Dim wrdApp As Word.Application 
Dim wrdDoc As Word.Document 
Dim wrdMergeDoc As Word.Document 
Dim strFilepath As String 

strFilepath = "O:\Church Phone List" 

'Require choice for church and district 
If IsNull(Me![ChurchCombo]) = True Then 
    MsgBox "Select church", , "Church Phone List" 
    Me.ChurchCombo.SetFocus 
    GoTo CloseSub 
End If 

strChurch = Me![ChurchCombo] 
strDistLang = Me![DistrictChoiceCombo] 

If strDistLang = "" Then 
    MsgBox "Select District", , "Church Phone List" 
    Me.DistrictChoiceCombo.SetFocus 
    GoTo CloseSub 
Else 
    strDistLang = IIf(Me![DistrictChoiceCombo] = "", "Church", Me![DistrictChoiceCombo]) 
End If 

'Create SQL string from present church/district information 
strSQL = "SELECT Churches.* " & vbCrLf & _ 
"FROM Churches " & vbCrLf & _ 
"WHERE (((Churches.Church)='" & strChurch & "') AND ((Churches.[District/Language])Like'" & strDistLang & "')) " & vbCrLf & _ 
"ORDER BY Churches.NAME;" 

Set wrdApp = CreateObject("Word.Application") 
wrdApp.Visible = True 

Set wrdDoc = wrdApp.Documents.Open(strFilepath & "\Phone Merge Document.docx") 

With wrdDoc 

    With .ActiveWindow 
     'Open the header/footer and add the church (and district if appropriate) 
     .ActivePane.View.SeekView = WdSeekView.wdSeekCurrentPageHeader 
     .Selection.EndKey Unit:=wdLine 
     .Selection.TypeText Text:=strChurch & IIf(strDistLang <> "Church", " (" & strDistLang & ")", "") 
     'Close header/footer 
     .ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument 
    End With 

    With .MailMerge 
     .MainDocumentType = wdCatalog 
     .OpenDataSource NAME:= _ 
      GetNamePath _ 
      , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _ 
      AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _ 
      WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _ 
      Format:=wdOpenFormatAuto, Connection:= _ 
      "DSN=MS Access Database;DBQ=" & strFilepath & "2017\Phone List 2017.mdb;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _ 
      , SQLStatement:=strSQL, SubType:= _ 
      wdMergeSubTypeOther 

     .Destination = wdSendToNewDocument 
     .SuppressBlankLines = True 
     With .DataSource 
      .FirstRecord = wdDefaultFirstRecord 
      .LastRecord = wdDefaultLastRecord 
     End With 
     .Execute Pause:=False 
    End With 

    .Close SaveChanges:=wdDoNotSaveChanges 

End With 

    With wrdApp 
     .Selection.WholeStory 
     With .Selection.ParagraphFormat 
      .SpaceBeforeAuto = False 
      .SpaceAfterAuto = False 
     End With 
     .Selection.ParagraphFormat.TabStops.ClearAll 
     .ActiveDocument.DefaultTabStop = InchesToPoints(0.5) 
     'Add a tab stop 
     .Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(0.1), _ 
      Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces 

     'Replace (C) and (¢) with [C] and [c] since auto replace for (c) may be enabled 
     .Selection.Find.Replacement.ClearFormatting 
     With .Selection.Find 
      .Text = "(C)" 
      .Replacement.Text = "[C]" 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Format = False 
      .MatchCase = True 
      .MatchWholeWord = False 
      .MatchWildcards = False 
      .MatchSoundsLike = False 
      .MatchAllWordForms = False 
     End With 
     .Selection.Find.Execute Replace:=wdReplaceAll 
     With .Selection.Find 
      .Text = "(¢)" 
      .Replacement.Text = "[c]" 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Format = False 
      .MatchCase = True 
      .MatchWholeWord = False 
      .MatchWildcards = False 
      .MatchSoundsLike = False 
      .MatchAllWordForms = False 
     End With 
     .Selection.Find.Execute Replace:=wdReplaceAll 

     'Lock document so track changes stays on 
     .ActiveDocument.Protect Password:="onebody1", NoReset:=False, Type:= _ 
      wdAllowOnlyRevisions, UseIRM:=False, EnforceStyleLock:=False 
     .ChangeFileOpenDirectory _ 
     strFilepath & "\Track-Change Documents\" 
    End With 

    strFind = "/" 
    strReplace = " " 

    strDistLang = Replace(strDistLang, strFind, strReplace) 

    wrdApp.ActiveDocument.SaveAs2 FileName:=strChurch & IIf(strDistLang <> "Church", " - " & strDistLang, ""), FileFormat _ 
     :=wdFormatXMLDocument, LockComments:=False, Password:="", _ 
     AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _ 
     EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _ 
     :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14 

    wrdApp.ActiveDocument.Activate 

'quit the word application: 

wrdApp.Quit 

MsgBox "Completed", , "Church Phone List" 

CloseSub: 

'Clear the object variables: 

Set wrdDoc = Nothing 
Set wrdApp = Nothing 

Exit_CreateWordMergeDoc_Click: 
Set wrdDoc = Nothing 
Set wrdApp = Nothing 
    Exit Sub 

Err_CreateWordMergeDoc_Click: 
MsgBox Err.Description 
    Resume Exit_CreateWordMergeDoc_Click 

End Sub 

誰かがエラーメートルに関しては、コードのクリーンアップに役立つことができれば、私は非常に感謝するだろうエッセージ。

+0

これはうまくいきました。私のテストは限られていましたが、これ以上のエラーメッセージはありませんでした。私はあなたの援助に非常に感謝しています! – KLJKevin

答えて

0

問題はおそらく、修飾されていないInchesToPointsメソッドへの呼び出しが原因であるようです。

アクセスApplicationオブジェクトがそのメソッドが含まれていることを(私はMSDN上で見ることができるものから)表示されていないので、それはWord.Applicationオブジェクトの一部である方法を使用するようにデフォルト設定されます。これにより、プログラムの最後にリリースされていないオブジェクトのインスタンスが作成されます。

最も簡単に解決できるのは、作成した遅延バインドWord.Applicationオブジェクトを使用することを指定して、つまりwrdApp.InchesToPointsを使用することで、呼び出しを修飾することです。

+0

InchesToPointsがうまくいった前にピリオドを置くだけでした。もう一度ありがとう! – KLJKevin

関連する問題