Suppress dialog box prompting the user to either enter a password for write-access or to open in read-only mode using VBA

Dear Experts:

below code, courtesy by Norie from EE copies specific worksheets into an aggregate file. Everything is fine with this code.

But now I have got a new requirement which should be intergrated into the below code.

The files from which contents are copied have regrettably been added a password to make them read-only.


If I run the macro now, I am greeted with a dialog box promping me to enter a password for write-access or open the file in read-only mode.

How is the below code to be altered so that the below dialog box is suppressed, i.e. open the files in read-only mode automatically would be ok, I guess.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

 
Option Explicit

Sub AggregateProdList()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim rngDst As Range
Dim rngSrc As Range
Dim strPath As String
Dim strFileName As String
Dim strAggFileName As String

    strPath = "C:\MyDocuments\MyFiles\"

    strAggFileName = "Aggregate_File.xlsx"

    ' if aggregate workbook is already open set a reference to it
    On Error Resume Next
    Set wbDst = Workbooks(strAggFileName)
    On Error GoTo 0


    ' if aggregate workbook isn't open then open it and set a reference to it.
    If wbDst Is Nothing Then
        Set wbDst = Workbooks.Open(strPath & strAggFileName)
    End If

    ' set reference to destination sheet
    Set wsDst = wbDst.Sheets("Overall_List")

    ' clear data from destination sheet
    wsDst.Range("A2").CurrentRegion.Offset(1).Delete

    ' set initial location to copy data to
    Set rngDst = wsDst.Range("A2")

    ' find the first xlsx file in the specified directory
    strFileName = Dir(strPath & "*.xlsx")

    Do

        ' check file isn't the aggregate file
        If strFileName <> strAggFileName Then

            ' open source file and set reference to it
            Set wbSrc = Workbooks.Open(strPath & strFileName)

            ' set reference to appropriate worksheet in source file
            Set wsSrc = wbSrc.Sheets("Prod_List")

            ' set reference to range to be copied from source worksheet
            Set rngSrc = wsSrc.Range("A2").CurrentRegion.Offset(1)

            ' copy data from source worksheet to destination worksheet
            rngSrc.Copy rngDst

            ' update the range to copy to on the destination sheet
            Set rngDst = wsDst.Range("A" & Rows.Count).End(xlUp).Offset(1)

            ' close the source file
            wbSrc.Close SaveChanges:=False
        End If

        ' get the next xlsx file in the specified directory
        strFileName = Dir

    Loop Until Len(strFileName) = 0

End Sub

Select allOpen in new window