Run-time Error '70': Permission Denied

Hi There!

I am running into an issue with a code someone developed for me. They are not responding to me lately and would like to get this resolved.

I am not very well-versed in VBA and so I am reaching out to the community to help.

I am experiencing a Run-time Error 70 with the following script. It references to template files contained within the same folder. Any help that someone might be able to offer would be very much appreciated!

-Phil

Option Explicit

Sub StartHere()
ufDNA.Show
End Sub
Sub PrintDocsSub(ReportType As String)
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim NewDoc As Word.Document
Dim WS As Worksheet
Dim A As Long, B As Long
Dim aRow As Long
Dim Cols As Variant
Dim FF As Integer
Dim Mypath As String
Dim sDBPath As String
Dim FN$
Dim DockNum As String

Set WS = ActiveSheet
Mypath = ActiveWorkbook.Path & "\"
FN$ = "Mergedata.dat"
'CreateHeaderFiles
    Application.ScreenUpdating = False
    Set wrdApp = CreateObject("Word.Application")
    'wrdApp.Visible = True 'If it's hanging, uncomment this to see if error in Word.
    
For A = 0 To ufDNA.lbData.ListCount - 1
        If ufDNA.lbData.Selected(A) Then
            aRow = ufDNA.lbData.List(A, 6)
            ufDNA.lblFeedback.Caption = "Working on docket " & WS.Range("F" & aRow)
            Select Case ReportType
            Case "CODNA"
            
                'ufDNA.lblFeedback.Caption = "Working on docket " & WS.Range("F" & aRow)
                Select Case ufDNA.lbData.List(A, 5)
                Case "YES"
                    'To prevent Merge from stopping and asking questions,
                    'all merge fields must be represented with a field name
                    'and a value, even if the value is empty.
                    Cols = Split("G,H,I,J,K,M,E,B,C,A,P,L,D,F,AG,AH,AC,N,S,Q,AJ", ",")
                    FF = FreeFile
                    Open Mypath & FN$ For Output As #FF
                        Write #FF, "SURNAME"; '--------------------G
                        Write #FF, "Given1"; '---------------------H
                        Write #FF, "Given2"; '---------------------I
                        Write #FF, "DOB"; '------------------------J
                        Write #FF, "FPS"; '------------------------K
                        Write #FF, "Order_Issue_Date"; '-----------M
                        Write #FF, "EPS_File"; '-------------------E
                        Write #FF, "RECEIVED_YYYYMM"; '------------B
                        Write #FF, "Day_DD"; '---------------------C
                        Write #FF, "Initial_Data_Entry_Member"; '--A
                        Write #FF, "Endorsement_"; '---------------P
                        Write #FF, "Offence"; '--------------------L
                        Write #FF, "FILE_"; '----------------------D
                        Write #FF, "Docket__Number"; '-------------F
                        Write #FF, "Order_to_Appear_Date"; '-------AG
                        Write #FF, "First_Possible_Warrant_Date"; 'AH
                        Write #FF, "Warrant_Issued"; '-------------AC
                        Write #FF, "Order_Execution_Date"; '-------N
                        Write #FF, "Member"; '---------------------S
                        Write #FF, "Time"; '-----------------------Q
                        Write #FF, "AB30059" '---------------------AJ
                    For B = 0 To UBound(Cols) - 1
                        Write #FF, WS.Range(Cols(B) & aRow);
                    Next
                        Write #FF, WS.Range(Cols(UBound(Cols)) & aRow)
                        Close #FF
                        Set wrdDoc = wrdApp.Documents.Add(ActiveWorkbook.Path & "\" & _
                            "A DNA Basic Documents Merge 2014-OCT-01 Endorsement.dot")
    
                Case "NO"
                    Cols = Split("G,H,I,J,K,M,E,B,C,A,P,L,D,F,AG,AH,AC,N,S,Q,AJ", ",")
                    FF = FreeFile
                    Open Mypath & FN$ For Output As #FF
                        Write #FF, "SURNAME"; '--------------------G
                        Write #FF, "Given1"; '---------------------H
                        Write #FF, "Given2"; '---------------------I
                        Write #FF, "DOB"; '------------------------J
                        Write #FF, "FPS"; '------------------------K
                        Write #FF, "Order_Issue_Date"; '-----------M
                        Write #FF, "EPS_File"; '-------------------E
                        Write #FF, "RECEIVED_YYYYMM"; '------------B
                        Write #FF, "Day_DD"; '---------------------C
                        Write #FF, "Initial_Data_Entry_Member"; '--A
                        Write #FF, "Endorsement_"; '---------------P
                        Write #FF, "Offence"; '--------------------L
                        Write #FF, "FILE_"; '----------------------D
                        Write #FF, "Docket__Number"; '-------------F
                        Write #FF, "Order_to_Appear_Date"; '-------AG
                        Write #FF, "First_Possible_Warrant_Date"; 'AH
                        Write #FF, "Warrant_Issued"; '-------------AC
                        Write #FF, "Order_Execution_Date"; '-------N
                        Write #FF, "Member"; '---------------------S
                        Write #FF, "Time"; '-----------------------Q
                        Write #FF, "AB30059" '---------------------AJ
                    For B = 0 To UBound(Cols) - 1
                        Write #FF, WS.Range(Cols(B) & aRow);
                    Next
                        Write #FF, WS.Range(Cols(UBound(Cols)) & aRow)
                        Close #FF
                        Set wrdDoc = wrdApp.Documents.Add(ActiveWorkbook.Path & "\" & _
                            "A DNA Basic Documents Merge 2014-OCT-01 Sample.dot")
                End Select
            
            Case "JudgeCourt"
                    'To prevent Merge from stopping and asking questions,
                    'all merge fields must be represented with a field name
                    'and a value, even if the value is empty.
                    Cols = Split("E,D,F,S,G,H,I,J,AL,AM,N,Q", ",")
                    FF = FreeFile
                    'Header row.  Required for merge.
                    Close
                    Open Mypath & FN$ For Output As #FF
                        Write #FF, "EPS_File"; '-------------------E
                        Write #FF, "FILE_"; '----------------------D
                        Write #FF, "Docket__Number"; '-------------F
                        Write #FF, "Member"; '---------------------S
                        Write #FF, "SURNAME"; '--------------------G
                        Write #FF, "Given1"; '---------------------H
                        Write #FF, "Given2"; '---------------------I
                        Write #FF, "DOB"; '------------------------J
                        Write #FF, "Endorsement_Merge_X"; '-------AL
                        Write #FF, "Sample_Merge_X"; '------------AM
                        Write #FF, "Order_Execution_Date"; '-------N
                        Write #FF, "Time" '------------------------Q-- Last Write has no semicolon.
                    'Data from sheet.
                    For B = 0 To UBound(Cols) - 1
                        Write #FF, WS.Range(Cols(B) & aRow);
                    Next
                    'We have to seperate the last record to produce a VbCr for record seperation.
                        Write #FF, WS.Range(Cols(UBound(Cols)) & aRow) 'Last column without semicolon produces VbCr.
                        Close #FF
                        'Open a new document based on template.
                        Set wrdDoc = wrdApp.Documents.Add(ActiveWorkbook.Path & "\" & _
                            "B Report to a Prov Court Judge or the Court OCT 2014.dotx")
            End Select
        End If
    
    ' or
    'Set wrdDoc = wrdApp.Documents.Open("C:\Foldername\Filename.doc")
    ' open an existing document
    ' example word operations
    If Not wrdDoc Is Nothing Then
        With wrdDoc
            'Move data here.
            With .MailMerge
                .MainDocumentType = wdFormLetters
                'Set up the mail merge data source to MergeData.dat
                sDBPath = Mypath & FN
                .OpenDataSource Name:=sDBPath, _
                   SQLStatement:="SELECT * FROM [EPS_File]"
                   'Grab record Docket number.  We'll use it to save file.
                   DockNum = .DataSource.DataFields("Docket__Number").Value
                    
                    'Perform the mail merge to a new document.
                    .Destination = wdSendToPrinter ' = 1
                    '.Destination = wdSendToNewDocument ' = 0
                    ufDNA.lblFeedback.Caption = "Printing " & WS.Range("F" & aRow)
                    .Execute Pause:=False
                    
                    'If .Destination = wdSendToNewDocument Then
                        'If the docket number is blank for some reason,
                        'just use a incremental number.
                        'If DockNum = "" Then
                            A = A + 1
                            DockNum = "Doc Num" & A
                        'End If
                        'Define object for merge document.
                        Set NewDoc = wrdApp.ActiveDocument
                        'Delete any previous version with the same name.
                        'If Dir(Mypath & DockNum & ".docx") <> "" Then
                            Kill Mypath & DockNum & ".docx"
                        'End If
                        'Save the new merged document using docket number as filename.
                        'NewDoc.SaveAs Mypath & DockNum & ".docx"
                        'Close the new document.
                        'NewDoc.Close False
                        Set NewDoc = Nothing
                    'End If
            End With
        End With
    'Close the template file.
    wrdDoc.Close True
    End If

    Set wrdDoc = Nothing
Next
    wrdApp.Quit ' close the Word application

    Set wrdApp = Nothing
    Application.ScreenUpdating = False
    ufDNA.lblFeedback.Caption = ""
End Sub

'Sub AgencyAssist()
'Day_DD
'Endorsement_Form
'EndorsementSample_Merge
'EPS_File
'FILE_
'Given1
'Given2
'Location_Merge
'Member
'Order_Execution_Date
'Order_to_a_Person_Merge
'RECEIVED_YYYYMM
'SURNAME
'EPS_File

'End Sub

TMS,

Thanks for responding. Please find attached the files in question. Unfortunately I cannot attach the template files because they aren't supported. I have attached the original documents that you could change to templates.B Report to a Prov Court Judge or the Court OCT 2014.docxA DNA Basic Documents Merge 2014-OCT-01 Sample.docA DNA Basic Documents Merge 2014-OCT-01 Endorsement.doc

To answer your questions:

Nothing has changed in my environment. The only thing that I did was add the Microsoft Office 14.0 object library in references. The documents have remained in the same folder the entire time.

An earlier version of this document was working just fine but has since also encountered the error 70.

I get the error code at

Open Mypath & FN$ For Output As #FF

Just above the code in relation the document that the 00 DNA Database Master Copy V3(1).xlsmAttachment 446240Attachment 44624100 DNA Database Master Copy V3(1).xlsmAttachment 446240Attachment 446241spreadsheet is trying to access for that line.

It happens regardless of what line I select.

Any help you can give would be great!!

-Phil

Originally Posted by TMS

These look like real names. If they are, I think you need to remove the examples.

They are actually all hockey player names. Not actually in relation to what we're doing here

Yes, I can create, save and modify all files in that location

I have Microsoft Word 15.0 as missing

Originally Posted by TMS

Guess that's the problem. If it's ticked you need to untick it and add Microsoft Word 14.0

I did uncheck it and then check Microsoft Word Object Library 14.0. That's when the run-time error appears