Opening a Word document from Excel file creates copies of excel files

[frankT68]

Hi!

I am having problems opening a Word document from Excel file. I am using the code below to open a Word document.

Sub open_word()

Application.StatusBar = "Please wait."
Set wordapp = CreateObject("word.Application")
wordapp.documents.Open "C:\Users\username\OneDrive\WordFile.docm"
    
    wordapp.Visible = True
   
End Sub

In this Word document (which I'm using as some kind of report file), I have links to data in the Excel file. These links are updated when I open the Word file, and this works fine.
The problem is that when I run the above code, additional copies of the original Excel file are created (at least I think so). These copies do not open and are not visible in the Excel application. However, when I close the original Excel file, the Excel always asks if I want to save the changes for those copies as well. I have also noticed that additional projects (always 9 additional projects) are created in the Visual Basic Editor (please see the below picture).

I would like to know why this is happening and how can I prevent it?

 

[sijpie]

Have you isolated the problem to this piece of code? ie, does the 'multiplication' happen because of opening Word? Or could there be another piece of your code that causes this to happen?

By commenting out bits of code you can check when the additional files appear. Or even by stepping through the code (pressing F8 key in the VBA).

 

[frankT68]

First of all, I must say that since there has been no answer on this forum for some time, I asked the question here as well. Nevertheless, I still have no answer as to why this problem occurs.

Have you isolated the problem to this piece of code? ie, does the 'multiplication' happen because of opening Word? Or could there be another piece of your code that causes this to happen?

First of all, I must say that I also asked the question here, since there has been no answer on this forum for some time, I asked the question here as well. Nevertheless, I still do not have an answer as to why this problem occurs.

Well, I think the problem might be related to the Word file. In the Excel file, the above code is the only code I have. In the Word file, I have a macro that updates the links, calls the macro to export from Word to PDF, and then closes Word. The code looks like this:

Sub AutoOpen()

ActiveDocument.Fields.Update

Call Word_ExportPDF2


Dim Msg, Style, Title, Response, MyString

Msg = "Should I close the document?"    ' Define message.

Style = vbYesNo Or vbCritical Or vbDefaultButton2    ' Define buttons.

Title = "Closing"    ' Define title.

        ' Display message.

Response = MsgBox(Msg, Style, Title)

If Response = vbYes Then    ' User chose Yes.

   Rem ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

Application.Quit SaveChanges:=wdDoNotSaveChanges

   ' Perform some action.

Else    ' User chose No.

    exit sub  ' Perform some action.

End If


End Sub


'https://www.thespreadsheetguru.com/the-code-vault/microsoft-word-vba-to-save-document-as-a-pdf-in-same-folder


Sub Word_ExportPDF2()

'PURPOSE: Generate A PDF Document From Current Word Document

'NOTES: PDF Will Be Saved To Same Folder As Word Document File

'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault


Dim CurrentFolder As String

Rem Dim FileName As String

Dim myPath As String

Dim UniqueName As Boolean

'Debug.Print FileName

UniqueName = False

Dim FileName As String


'Store Information About Word File

  myPath = ThisDocument.FullName

 


    CurrentFolder = ActiveDocument.Path & "\"

    

'Debug.Print CurrentFolder

    

 FileName = Mid(ActiveDocument.Name, InStrRev(ActiveDocument.Name, "\") + 1, InStrRev(ActiveDocument.Name, ".") - InStrRev(ActiveDocument.Name, "\") - 1) & "_" & RTrim(LTrim(ActiveDocument.Bookmarks("Month").Range.Text)) & "_" & RTrim(LTrim(ActiveDocument.Bookmarks("Year").Range.Text))




'Does File Already Exist?

  Do While UniqueName = False

    dirFile = CurrentFolder & FileName & ".pdf"

    Debug.Print dirFile

    Debug.Print Len(Dir(CurrentFolder & FileName & ".pdf"))

    If Len(Dir(dirFile)) <> 0 Then

      UserAnswer = MsgBox("File Already Exists! Click " & _

       "[Yes] to override. Click [No] to Rename.", vbYesNoCancel)

      

      If UserAnswer = vbYes Then

        UniqueName = True

      ElseIf UserAnswer = vbNo Then

        Do

          'Retrieve New File Name

            FileName = InputBox("Provide New File Name " & _

             "(will ask again if you provide an invalid file name)", _

             "Enter File Name", FileName)

          

          'Exit if User Wants To

            If FileName = "False" Or FileName = "" Then Exit Sub

        Loop While ValidFileName(FileName) = False

      Else

        Exit Sub 'Cancel

      End If

    Else

      UniqueName = True

    End If

  Loop

 

'Save As PDF Document

  On Error GoTo ProblemSaving

    ActiveDocument.ExportAsFixedFormat _

     OutputFileName:=CurrentFolder & FileName & ".pdf", _

     ExportFormat:=wdExportFormatPDF

     Rem Debug.Print CurrentFolder & FileName & ".pdf"

  On Error GoTo 0


'Confirm Save To User

  With ActiveDocument

    FolderName = Mid(.Path, InStrRev(.Path, "\") + 1, Len(.Path) - InStrRev(.Path, "\"))

  End With

 

  MsgBox "PDF Saved in the Folder: " & FolderName


'opens pdf file

ActiveDocument.FollowHyperlink Address:=CurrentFolder & FileName & ".pdf"


Exit Sub


'Error Handlers

ProblemSaving:

  MsgBox "There was a problem saving your PDF. This is most commonly caused" & _

   " by the original PDF file already being open."

  Exit Sub


End Sub



Function ValidFileName(FileName As String) As Boolean

'PURPOSE: Determine If A Given Word Document File Name Is Valid

'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault


Dim TempPath As String

Dim doc As Document


'Determine Folder Where Temporary Files Are Stored

  TempPath = Environ("TEMP")


'Create a Temporary XLS file (XLS in case there are macros)

  On Error GoTo InvalidFileName

    Set doc = ActiveDocument.SaveAs2(ActiveDocument.TempPath & _

     "\" & FileName & ".doc", wdFormatDocument)

  On Error Resume Next


'Delete Temp File

  Kill doc.FullName


'File Name is Valid

  ValidFileName = True


Exit Function


'ERROR HANDLERS

InvalidFileName:

'File Name is Invalid

  ValidFileName = False


End Function

When I run the code in the Excel file, I can see that the screen flashes nine times after the Word file is opened. This is when copies of the Excel file are created. I have managed to locate these files - they are in two folders:

"C:\Users\usrename\AppData\Local\Microsoft\Windows\INetCache\ IE \7SCW6Q0Z" contains 4 files.



"C:\Users\username\AppData\Local\Microsoft\Windows\INetCache\ IE \XTMMVNHV" contains 5 files.

All copies have the same size and name (the only difference is the number at the end of the files names).

If I delete both folders, they are recreated when I run the code again.

Could this behavior be due to the fact that I recently moved both files to the OneDrive folder so I can access these files on different computers?

 

[sijpie]

The function to check if a filename is valid creates temporary files, so apparently does not delete them properly (I think because the file is open or so).

I have commented out this function and added a new function that just replaces any invalid characters with a _. Simpler that way.

I have also cleaned up the code a bit. There were a number of variables not declared, or declared without type. Sloppy programming.
Start ANY new module with "Option Explicit" to force variable declaration. That much safer.
Maybe I missed a couple of variables. In that case the VBA editor will open complaining about a undeclared variable. Just add it to the Dim list in that sub/function.

Option Explicit

Sub AutoOpen()
    Dim Msg As String, Style As VbMsgBoxStyle, Title As String, Response As VbMsgBoxResult
    
    ActiveDocument.Fields.Update
    Call Word_ExportPDF2
    
    Msg = "Should I close the document?"    ' Define message.
    
    Style = vbYesNo Or vbCritical Or vbDefaultButton2    ' Define buttons.
    
    Title = "Closing"    ' Define title.
    
            ' Display message.
    
    Response = MsgBox(Msg, Style, Title)
    
    If Response = vbYes Then    ' User chose Yes.
    
        Application.Quit SaveChanges:=wdDoNotSaveChanges
    
    End If
    

End Sub


'https://www.thespreadsheetguru.com/the-code-vault/microsoft-word-vba-to-save-document-as-a-pdf-in-same-folder


Sub Word_ExportPDF2()
'PURPOSE: Generate A PDF Document From Current Word Document
'NOTES: PDF Will Be Saved To Same Folder As Word Document File
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault


    Dim CurrentFolder As String, Filename As String, dirFile As String, myPath As String
    Dim UniqueName As Boolean
    Dim UserAnswer As VbMsgBoxResult
    
    
    UniqueName = False
    
    'Store Information About Word File

    myPath = ThisDocument.FullName

    CurrentFolder = ActiveDocument.path & "\"
    With ActiveDocument
        Filename = Mid(.Name, InStrRev(.Name, "\") + 1, InStrRev(.Name, ".") - InStrRev(.Name, "\") - 1) & _
            "_" & RTrim(LTrim(.Bookmarks("Month").Range.Text)) & "_" & RTrim(LTrim(.Bookmarks("Year").Range.Text))
    End With



'Does File Already Exist?

  Do While UniqueName = False
    dirFile = CurrentFolder & Filename & ".pdf"
'    Debug.Print dirFile
'    Debug.Print Len(Dir(CurrentFolder & FileName & ".pdf"))

    If Len(Dir(dirFile)) <> 0 Then
        UserAnswer = MsgBox("File Already Exists! Click " & _
            "[Yes] to override. Click [No] to Rename.", vbYesNoCancel)

        If UserAnswer = vbYes Then
            UniqueName = True

        ElseIf UserAnswer = vbNo Then

              'Retrieve New File Name
            Filename = InputBox("Provide New File Name " & _
                    "(will ask again if you provide an invalid file name)", _
                    "Enter File Name", Filename)
              'Exit if User Wants To
            If Filename = "False" Or Filename = "" Then Exit Sub
            Filename = ReturnValidFilename(Filename)
        Else
            Exit Sub 'Cancel
        End If
    Else
        UniqueName = True
    End If
  Loop

'Save As PDF Document

    On Error GoTo ProblemSaving
        ActiveDocument.ExportAsFixedFormat _
            OutputFileName:=CurrentFolder & Filename & ".pdf", _
            ExportFormat:=wdExportFormatPDF
     Rem Debug.Print CurrentFolder & FileName & ".pdf"
    On Error GoTo 0


    'Confirm Save To User

    With ActiveDocument
        FolderName = Mid(.path, InStrRev(.path, "\") + 1, Len(.path) - InStrRev(.path, "\"))
    End With

    MsgBox "PDF Saved in the Folder: " & FolderName

    'opens pdf file
    ActiveDocument.FollowHyperlink Address:=CurrentFolder & Filename & ".pdf"
    Exit Sub

'Error Handlers
ProblemSaving:
  MsgBox "There was a problem saving your PDF. This is most commonly caused" & _
   " by the original PDF file already being open."

  Exit Sub

End Sub

Function ReturnValidFilename(Filename As String) As String
' Replace all invalid charachters with _ in filename

    Const sINVALID As String = "/ \ : * ? "" < > |"
    Dim vS As Variant
    Dim i As Integer
    Dim sChecked As String
    
    sChecked = Filename
    vS = Split(sINVALID, " ")
    For i = 0 To UBound(vS)
        sChecked = Replace(sChecked, vS(i), "_")
    Next i
    ReturnValidFilename = sChecked
End Function


'Superfluous - seems to generate temp files which do not get deleted
''Function ValidFileName(Filename As String) As Boolean
'''PURPOSE: Determine If A Given Word Document File Name Is Valid
'''SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
''    Dim TempPath As String
''    Dim doc As Document
''
''    'Determine Folder Where Temporary Files Are Stored
''      TempPath = Environ("TEMP")
''
''    'Create a Temporary word file
''      On Error GoTo InvalidFileName
''        Set doc = ActiveDocument.SaveAs2(ActiveDocument.TempPath & _
''         "\" & Filename & ".doc", wdFormatDocument)
''      On Error Resume Next
''
''    'Delete Temp File
''    Kill doc.FullName
''
''
''    'File Name is Valid
''    ValidFileName = True
''    Exit Function
''
''
''    'ERROR HANDLERS
''
''InvalidFileName:
''    'File Name is Invalid
''    ValidFileName = False
''
''End Function

 

[frankT68]

Thank you for your comments and advice sijpie. I'm currently on s short vacation and will try your soulution when I'm back.

 

[frankT68]

Sijpie, thank you again for your answer. I can agree that programming is sloppy. I am not a programmer, and I am learning all the time.
I tested your code and found that the part shown below is causing the Runtime Error '5941' The Requested Member of Collection Does Not Exist.

    With ActiveDocument
         FileName = Mid(.Name, InStrRev(.Name, "\") + 1, InStrRev(.Name, ".") - InStrRev(.Name, "\") - 1) & _
            "_" & RTrim(LTrim(.Bookmarks("Month").Range.Text)) & "_" & RTrim(LTrim(.Bookmarks("Year").Range.Text))
    End With

If I replace this part with the original code, there is no error.

Unfortunately, although you edited the code, the problem still remains - every time I run a macro, copies of the Excel file are created.

The problem only occurs if the original Excel file and the Word file are stored in the OneDrive folder. If they are stored elsewhere (not in OneDrive), there is no problem.
Could the cause of the problem be moving both files to the OneDrive folder so that I can access those files on different computers?

 

[sijpie]

Look at the difference in the way paths are formed on a local drive and OneDrive.
Locally the folder delimiter is \
On OneDrive it is /

You are parsing the file path using the \. So it works fine on a local drive, but not in OneDrive.

If you declare a Stringvariable Dim sDelim as String and then set it to the relevant delimiter using a check:

if .Name like "*/*" then
    sDelim = "/"
Else
    sDelim = "\"
End if

Then do your path thing, using sDelim instead of the fixed "\" , it should work

 

[frankT68]

Thanks Sijpie.

if .Name like "*/*" then
    sDelim = "/"
Else
    sDelim = "\"
End if

This solution fixes the runtime error but unfortunately does not solve the problem of creating copies of Excel files. I'm very sure the problem isn't in the code, but it's related to storing files in OneDrive.

 

[sijpie]

Still weird...