Excel VBA NOT Contacting Word Correctly (Machine Specific)

[Wobbs91]

I have a macro that uses data from an Excel sheet and to fill out a form in a Word document. Everything seems to be working fine except for one user. The macro is supposed to open a specific document and paste data into the correct spaces. One user's computer opens the Word form but then also opens another blank Word document and pasts variables into the blank document. Again, this is just one computer that is doing this...

[Ecniv]

Probably a configuration setting on opening Word. I think I remember that you can request a blank doc on opening word. Perhaps this is happening, but after the document you wanted to load so the Selection object is pointing to that.

Do you use Object variables or Selection object? If a selection object, then update your code to use object variables and it shouldnt matter if the blank doc appears.

Alternatively, re-install office on that one machine.

[Wobbs91]

Probably a configuration setting on opening Word. I think I remember that you can request a blank doc on opening word. Perhaps this is happening, but after the document you wanted to load so the Selection object is pointing to that.

Do you use Object variables or Selection object? If a selection object, then update your code to use object variables and it shouldnt matter if the blank doc appears.

Alternatively, re-install office on that one machine.

I don't think it's a settings issue. Today my machine started doing this also (no change to settings and was working properly before). I am using object variables. What would cause it change?

[westconn1]

What would cause it change?

maybe windows updates

I am using object variables.

post the code you are using, someone may be able to suggest a solution

[Wobbs91]

maybe windows updates
post the code you are using, someone may be able to suggest a solution

Here is my code, sorry if it has mistakes. I am self-taught and generally march to the beat of my own drum.

Sub PE140Generate()
Dim lrow As Integer
Dim pprnum As Integer
Dim prnum As String
Dim Rng As Range
Dim protonum As String
Dim requser As String
Dim sdescription As String
Dim dsubmitted As String
Dim pleft As Integer
Dim solvedira As String
Dim solvedirb As String
Dim fpath As String
Dim wDoc As String
Dim solvedir As String

lrow = Cells(Rows.Count, 2).End(xlUp).Row
pprnum = Cells(lrow, 1).Value

prnum = InputBox("Generate Request for request number: ", "PE-140", pprnum)
If prnum = "" Then Exit Sub

'finds row number if a PE-140 is required for a row that is not the last, redefines lrow and pprnum if true
On Error GoTo Ending
If prnum <> " " And prnum <> pprnum Then
With Sheets("Sheet1")
Set Rng = .Range("A:A").Find(What:=prnum, LookIn:=xlValues)
End With
lrow = Rng.Row
pprnum = Cells(lrow, 1).Value
End If
On Error GoTo 0

'define variables for variables being transfered & save location
protonum = Cells(lrow, 1).Value
requser = Cells(lrow, 3).Value
sdescription = Cells(lrow, 2).Value
dsubmitted = Cells(lrow, 4).Value
fpath = "\\[REAL NETWORK PATH\\"


If sdescription = "" Or requser = "" Then
MsgBox "You have not filled out all required information for that request number!" & Chr(13) & Chr(13) & "Please try again."
GoTo Ending
End If

pleft = Left(protonum, 2)
If Right(protonum, 2) = 0 Then
solvedira = ((pleft - 1) * 100 + 1)
solvedirb = pleft * 100
solvedir = solvedira & "-" & solvedirb & "\"
End If

If Right(protonum, 2) <> 0 Then
solvedira = pleft * 100 + 1
solvedirb = (pleft + 1) * 100
solvedir = solvedira & "-" & solvedirb & "\"
End If

'defines, opens, and sets focus on word docuement
wDoc = "\\[REAL FILE LOCATION]\Rename_Me_PR-XXXX.dotx"

Application.EnableEvents = False
Dim objWord As Object
Set objWord = CreateObject("Word.Application")

'Set objDoc = objWord.documents.Open(wDoc)
Set objDoc = objWord.documents.Add(wDoc)
'objWord.documents.Add (wDoc)

'objWord.Documents.Open wDoc
'objWord.Activate
objWord.Visible = True
'objDoc.Application.Activate
Application.ActivateMicrosoftApp xlMicrosoftWord
objWord.ActiveWindow.View.ReadingLayout = False

'set save file name
If FileThere(fpath & solvedir & protonum & "\PR# " & protonum & " " & sdescription & ".docx") Then
Application.Visible = True
MsgBox "A request already exists for PR#" & protonum & "." & Chr(13) & Chr(13) & "The form you generated is minimized and will not be saved."
GoTo SkipSave
End If

If sdescription <> "" Or requser <> "" Then
objDoc.SaveAs (fpath & solvedir & protonum & "\PR# " & protonum & " " & sdescription & ".docx")
'objWord.documents.SaveAs (fpath & solvedir & protonum & "\PR# " & protonum & " " & sdescription & ".docx")
End If

SkipSave:
'find text and insert values into word document
objWord.Selection.WholeStory
objWord.Selection.Find.ClearFormatting

With objWord.Selection.Find
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchAllWordForms = False
    .Execute findtext:="Proto No."
End With

objWord.Selection.MoveRight Count:=3
objWord.Selection.TypeText Text:=protonum

objWord.Selection.WholeStory
objWord.Selection.Find.ClearFormatting

With objWord.Selection.Find
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchAllWordForms = False
    .Execute findtext:="Requested By:"
End With

objWord.Selection.MoveRight Count:=2
objWord.Selection.TypeText Text:=requser

objWord.Selection.WholeStory
objWord.Selection.Find.ClearFormatting

With objWord.Selection.Find
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchAllWordForms = False
    .Execute findtext:="Sample Description:"
End With

objWord.Selection.MoveRight Count:=4
objWord.Selection.TypeText Text:=sdescription

objWord.Selection.WholeStory
objWord.Selection.Find.ClearFormatting

With objWord.Selection.Find
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchAllWordForms = False
    .Execute findtext:="Date Submitted:"
End With

objWord.Selection.MoveRight Count:=3
objWord.Selection.TypeText Text:=dsubmitted

objWord.Selection.WholeStory
objWord.Selection.Find.ClearFormatting

With objWord.Selection.Find
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchAllWordForms = False
    .Execute findtext:="Proto No."
End With

objWord.Selection.MoveLeft Count:=1
Application.EnableEvents = True

Ending:
End Sub

[westconn1]

Dim objWord As Object
Set objWord = CreateObject("Word.Application")

'Set objDoc = objWord.documents.Open(wDoc)
Set objDoc = objWord.documents.Add(wDoc)

here you initiate a new instance of Word, the commented line should have opened a specific document, whereas you are actually adding a new document based on a specific template, which appears to be correct, but as the template appears to be on a network share, if may be basing the new document on the default template

at least for testing purposes, first, i would check the existence /availability of the template

if len(dir(wdoc)) = 0 then msgbox "template not found"

and /or try creating a new document in word based on the template

of course you may have already tried some of the above
also for testing, i would make objword visible earlier, just so i could see what is going on

[Wobbs91]

here you initiate a new instance of Word, the commented line should have opened a specific document, whereas you are actually adding a new document based on a specific template, which appears to be correct, but as the template appears to be on a network share, if may be basing the new document on the default template

at least for testing purposes, first, i would check the existence /availability of the template

if len(dir(wdoc)) = 0 then msgbox "template not found"

and /or try creating a new document in word based on the template

of course you may have already tried some of the above
also for testing, i would make objword visible earlier, just so i could see what is going on

I can confirm the template exists and I am able to create a new document by clicking on the template. Is it possible that it is a network issue? Maybe communication is taking too long and Word opens a blank document rather than the template when the time comes to paste information?

[westconn1]

I can confirm the template exists and I am able to create a new document by clicking on the template.

that is why i suggested the code to make sure that vba could also see the file there, before trying to use

Maybe communication is taking too long

for testing copy the template to the local machine

[Wobbs91]

that is why i suggested the code to make sure that vba could also see the file there, before trying to use

for testing copy the template to the local machine

I added the line of code you suggested. When this happened again (pulling template from local drive) the message box was not triggered.