Closing word documents correctly

[Jer3miah]

Hi!

I'm think I'm having trouble closing my word documents properly.
I say 'think' because I don't really know what's causing my problem.

There is a folder called 'PDF' which contains a variable amount of PDF files;
each one of these PDF files contain a single unique e-mail adress.

Desired outcome:
- I open my word document
- It lists all the E-mail adresses from the PDF files in the 'PDF' folder.

Current outcome:
- When it works (about 60% of the time):
it leaves about 5 active word processes which I can see in taskmanager.
- When it doesn't work:
It freezes and I see numerous active word processes in taskmanager
(Way more than the amount of PDF files in the folder)

All help is greatly appreciated!
This is my code:

(Option Explicit)

Private Sub Document_Open() 'Upon opening the document

'Update the Bookmark
RangeMyBookmark "output", "Please wait..."
'Define the locations
Dim PDFLocation As String
Dim TempLocation As String
PDFLocation = "C:\Users\Wim\Downloads\PDF\"
TempLocation = CStr(CreateObject("WScript.Shell").specialfolders("Desktop") & "\")

'-------------CONVERT PDF FILES TO WORD DOCUMENTS---------------------------------------

Dim file As Variant 'Setup file path variable
file = Dir(PDFLocation & "*.pdf") 'Set the path to the first PDF in the folder

Do While (file <> "") 'Open PDF, Save as DOCX, Close Document, Go to Next PDF

ChangeFileOpenDirectory PDFLocation 'Set the Directory
'Open the PDF file
Documents.Open FileName:=file, ConfirmConversions:=False, ReadOnly:= _
False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
"", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto, XMLTransform:=""

ChangeFileOpenDirectory TempLocation 'Set the Directory
'Save as DOCX file
ActiveDocument.SaveAs2 FileName:=Replace(file, ".pdf", ".docx"), FileFormat:=wdFormatXMLDocument _
, LockComments:=False, Password:="", AddToRecentFiles:=True, _
WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, CompatibilityMode:=15

'Close Document, set Path to next PDF
ActiveDocument.Close
file = Dir

Loop

'-------------ADD DOCX FILES TO ARRAY: files()-------------------------------------------

'Set the path to the first DOCX in the temp folder
file = ""
file = Dir(TempLocation & "*.docx")
'CREATE THE ARRAY
Dim files() As String
'SETUP 'i' VARIABLE FOR LOOPING
Dim i As Integer
i = 0
Do While (file <> "") 'LOOP TO FIND THE NUMBER OF TEXT FILES
i = i + 1
file = Dir
Loop
'DEFINE SIZE OF THE ARRAY ACCORDINGLY
ReDim files((i - 1))
'Set the path to the first DOCX in the temp folder
file = ""
file = Dir(TempLocation & "*.docx")
i = 0 'RESET LOOPING VAR
Do While (file <> "") 'LOOP TO POPULATE THE ARRAY
files(i) = CStr(file)
file = Dir
i = i + 1
Loop

'-------------SCRAPE MAIL ADRESSESS FROM: files()---------------------------------------------------

'ADJUST 'i' FOR CORRECT NUMBER OF LOOPS
i = CInt(UBound(files))
'EMPTY 'file', IT WILL NOW BECOME THE MAIL ADRESS
file = ""
'CREATE OBJECTS NEEDED
Dim WApp As Object, WDoc As Object
'CREATE VARIABLE FOR THE FINAL OUTPUT
Dim mails As String
mails = "E-Mail adressess:" & vbNewLine

'LET'S LOOP!
Dim x As Integer
For x = 0 To i

'Open the first Docx File
Set WApp = CreateObject("Word.Application")
WApp.Visible = False
Set WDoc = WApp.Documents.Open(TempLocation & CStr(files(x)))
'Scrape it for the address
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "E-mailadres"
WApp.Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove
file = CStr(WApp.Selection)
'Quit the document
WDoc.Close
WApp.Quit
'Empty the objects
Set WDoc = Nothing
Set WApp = Nothing
'Add the address to the final output
mails = mails & file & vbNewLine

Next x

'-------------CLEANUP! DELETE THE DOCX FILES FROM THE TEMP FOLDER!----------------------------------

For x = 0 To i
SetAttr TempLocation & CStr(files(x)), vbNormal
Kill TempLocation & CStr(files(x))
Next x

'-------------CHANGE BOOKMARK TO THE FINAL OUTPUT! :) ---------------------------------------------------

RangeMyBookmark "output", mails

End Sub
Sub to update the Word Bookmark:

Private Sub RangeMyBookmark(sBm As String, sCtl As String)
Dim oRange As Word.Range
With ActiveDocument
Set oRange = .Bookmarks(sBm).Range
oRange.Text = sCtl
.Bookmarks.Add sBm, oRange
Set oRange = Nothing
End With
End Sub
- Jeremy

[gmayor]

If you are running the code from Word VBA, why are you creating Word applications?

Set WApp = CreateObject("Word.Application")
You are already in a Word Application You don't need another one.
I am unable to test your code without access to the documents, but the following should work assuming the search string is correct. There are two d's and two s's in Address

Dim x As Integer
For x = 0 To i

'Open the first Docx File
Set WDoc = Documents.Open(TempLocation & CStr(Files(x)))
'Scrape it for the address
Selection.HomeKey Unit:=6
Selection.Find.ClearFormatting
Selection.Find.Execute "E-mailadres" 'is this correct?
Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove
File = CStr(Selection)
'Quit the document
WDoc.Close
'Empty the objects
Set WDoc = Nothing
'Add the address to the final output
mails = mails & File & vbNewLine
Next x

[Jer3miah]

If you are running the code from Word VBA, why are you creating Word applications?
You are already in a Word Application You don't need another one.
Thank you VERY much! :content:
This eliminated my problem!

P.S.
The documents are in Dutch, so that explains "E-mailadres"

[Jer3miah]

Hey,

I've shared the file and it's being used on multiple machines;
one of them runs into an issue.

This machine has 'Nuance PDF Creator' installed, and when Word opens one of the PDF files its 'pdf to word' converter launches.
Not only does this launcher take quite a while to boot up, you have to then click a button inside this converter for it to work.
This is very tedious since there are a lot of PDF files in the folder.

Is there a way to force Word to use its own conversion using VBA?
Disabling the word-integration from inside the Nuance program has already been tried, but this sadly wasn't succesfull.

All help is greatly appreciated!

[gmayor]

Does that PC have Word 2013 or later installed? If so, I suspect the only solution is to disable the Nuance add-in which is intercepting the command, although I have no experience of using Nuance.

[macropod]

Disabling the word-integration from inside the Nuance program has already been tried, but this sadly wasn't succesfull
Have you tried disabling the Nuance addin from within Word (via File|Options|Addins)?

[Jer3miah]

Thank you both for your replies!
The computer has Office 365, Word 2016 Installed.

I've now managed to set the Nuance Addins to inactive inside Word:

20987

Just in case, I've also disabled Word integration inside the Nuance program:

20986

Sadly nothing seems to have changed :(
The Nuance converter still boots up instead of Word coverting the PDF itself.
- Jeremy

[Kilroy]

I had a similar issue. It was because the default PDF program was "edge" and not Adobe.

https://helpx.adobe.com/acrobat/kb/not-default-pdf-owner-windows10.html

Here is a bit of code I use to open docs in Word.


Sub OpenDocs()
Dim intChoice As Integer
Dim strPath As String
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)

End If

Dim Doc As Document
Set Doc = Documents.Open(strPath)
With Doc
Application.Run MacroName:="RunAll"

End With

End Sub

[gmaxey]

Kilroy,

Referring to Graham's comment above. If you are opening documents with VBA from within Word, why do you create a new application of Word? Your code can be reduced to:


Sub OpenDocs2()
Dim oDoc
With Application
.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
If .FileDialog(msoFileDialogOpen).Show <> 0 Then
Set oDoc = Documents.Open(.FileDialog( _
msoFileDialogOpen).SelectedItems(1))
.Run MacroName:="RunAll"
End If
End With
End Sub

[Jer3miah]

Kilroy, sadly didn't work !
If anyone has other suggestions, I'd be very gratefulll!
- Jeremy

[Kilroy]

I've recently been having similar issues when working with PDF's from word. My problem was that the PDF's or portions of them were locked from editing. When all docs were fully unlocked before running VBA there was no problem.