Create temp copy of document

[wrightyrx7]

Hi all,

I have created a tool in Access to generate letters from data in a SQL Server which is working fine.

However, there is 10+ users of this tool and only 1 Word Document on the network drive. I have a problem with the Word Document, SOMETIMES its does not close down properly and I have to close it via task manager (Processes) on the users computer. This stops the tool working for everyone else because someone is in the document.

So what i was thinking is each time the user presses generate it creates a copy of the word document locally, completes the merge, then deletes the copy.

Or maybe someone could look at my code and see if they can spot why sometimes the document doesnt close properly.

I have a FUNCTION for the Save Location as i use if for a few different forms.

Private Sub Gen()

Dim MyWord As Word.Application
Dim cType As String
Dim strFileName As String
    
    strFileName = "\\opdeptfs1\test.docx"


wordDoc = SaveLoc(Me.EmpID)

    Set MyWord = New Word.Application
        With MyWord
            .Documents.Open (strFileName)
            
                .ActiveDocument.Bookmarks("FORENAME1").Range.Text = Me.FORENAME
                .ActiveDocument.Bookmarks("SURNAME1").Range.Text = Me.SURNAME

            .ActiveDocument.SaveAs2 wordDoc, 17
        End With
    DoEvents

    MyWord.Quit savechanges:=wdDoNotSaveChanges
    Set MyWord = Nothing
    strFileName = ""
    wordDoc = ""
    MsgBox ("Complete")

End Sub
Function SaveLoc(EmpID As String) As String
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Save Location for PDF"
        .InitialFileName = EmpID
        If .Show = True Then
            If Right(.SelectedItems(1), 4) = ".pdf" Then
                SaveLoc = .SelectedItems(1)
            Else
                SaveLoc = .SelectedItems(1) & ".pdf"
            End If
        Else
            SaveLoc = ""
        End If
    End With
End Function

 

[arnelgp]

this will copy the .docx file to local\mydocuments:

Private Sub Gen()

Dim MyWord As Word.Application
Dim cType As String
Dim strFileName As String

'== arnelgp code

strFileName = SpecialFolderPath("MyDocuments") & "\test.docx"
' delete old file
if dir(strFileName)<>"" then Kill (strFileName)
    
'copy the template
FileCopy "\\opdeptfs1\test.docx", strFileName

'== end of arnelgp code

'    strFileName = "\\opdeptfs1\test.docx"


wordDoc = SaveLoc(Me.EmpID)

    Set MyWord = New Word.Application
        With MyWord
            .Documents.Open (strFileName)
            
                .ActiveDocument.Bookmarks("FORENAME1").Range.Text = Me.FORENAME
                .ActiveDocument.Bookmarks("SURNAME1").Range.Text = Me.SURNAME

            .ActiveDocument.SaveAs2 wordDoc, 17
        End With
    DoEvents

    MyWord.Quit savechanges:=wdDoNotSaveChanges
    Set MyWord = Nothing
    strFileName = ""
    wordDoc = ""
    MsgBox ("Complete")

End Sub
Function SaveLoc(EmpID As String) As String
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Save Location for PDF"
        .InitialFileName = EmpID
        If .Show = True Then
            If Right(.SelectedItems(1), 4) = ".pdf" Then
                SaveLoc = .SelectedItems(1)
            Else
                SaveLoc = .SelectedItems(1) & ".pdf"
            End If
        Else
            SaveLoc = ""
        End If
    End With
End Function

put in a module:

Public Function SpecialFolderPath(strFolder As String) As String
    ' Find out the path to the passed special folder. User on of the following arguments:
    ' Options For specical folders
'        AllUsersDesktop
'        AllUsersStartMenu
'        AllUsersPrograms
'        AllUsersStartup
'        Desktop
'        Favorites
'        Fonts
'        MyDocuments
'        NetHood
'        PrintHood
'        Programs
'        Recent
'        SendTo
'        StartMenu
'        Startup
'        Templates
 
   On Error GoTo ErrorHandler
 
   'Create a Windows Script Host Object
      Dim objWSHShell As Object
      Set objWSHShell = CreateObject("WScript.Shell")
 
   'Retrieve path
      SpecialFolderPath = objWSHShell.specialfolders(strFolder & "")
 
CleanUp:
   ' Clean up
      Set objWSHShell = Nothing
      Exit Function
 
'**************************************
'*      Error Handler
'**************************************
ErrorHandler:
    MsgBox "Error finding " & strFolder, vbCritical + vbOKOnly, "Error"
    Resume CleanUp
End Function