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!
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:

Naamloos.jpg

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

Nuance.jpg

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/n...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.