CODEWITHSUNDEEP
excelms-accessvba
isic5
isic5

Reputation: 191

Access VBA script to open and save excel files on network drive doesnt save files

I have a script in Access that is supposed to loop through excel files in a shared network drive, open and save them.

When running the script on a local folder it works as intended, but when running it on the network drive a popup appears saying:'A file with this name already exists in this location, do you want to save it anyways? When I press yes the popup closes, but upon checking the timestamp of the files, non of them have been overwritten.

Here is the script:

Sub demo()
Dim directory As String, fileName As String
Dim Mywb As Workbook
Dim app As New Excel.Application
app.Visible = True
directory = "Y:\E. Data Hub\4. KPIs\C. Price Competitiveness\2018\07 July\DT\"
fileName = Dir(directory & "*.xls")

Do While fileName <> ""
Workbooks.Open (directory & fileName)
fileName = Dir()
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Loop

app.Quit


End Sub

Ideally I wouldnt even receive those popups that I have to confirm manually and of course the files should be saved/overwritten.

Edit: I think the issue seems to be that the files are opened in read only mode. I tried fixing that issue by adding 'ReadOnly:=False, Notify:=False' to my Workbooks.Open command, but this does not work and the files still get opened in read only mode.

Second edit: Check below for a solution I answered my own question.

Upvotes: 0

Views: 1381

Answers (2)

isic5
isic5

Reputation: 191

I found a solution to my specific issue so for anyone having the same issue in the future: For me the issue was a result of the files being opened in 'read only' mode in excel.

To solve this I included 

ActiveWorkbook.LockServerFile

into my loop.

This is the equivalent of pressing the 'edit workbook' button on excel. My full code now looks like this:

Sub demo()

Dim directory As String, fileName As String
Dim Mywb As Workbook
Dim app As New Excel.Application
app.Visible = True
directory = "Y:\E. Data Hub\4. KPIs\C. Price Competitiveness\2018\07 July\DT\"
fileName = Dir(directory & "*.xls")
Application.Echo False
DoCmd.SetWarnings False

Do While fileName <> ""

Workbooks.Open (directory & fileName)
fileName = Dir()
ActiveWorkbook.LockServerFile
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.Save
ActiveWorkbook.Close

Loop

app.Quit
DoCmd.SetWarnings True
Application.Echo True

End Sub

Upvotes: 2

DaanV
DaanV

Reputation: 339

You can stop most message that excel asks the user by switching this option:

Application.DisplayAlerts

so in your code it would look like:

Public Sub demo()

    Dim directory As String, fileName As String
    Dim Mywb As Workbook
    Dim app As New Excel.Application
    app.Visible = True

    directory = "Y:\E. Data Hub\4. KPIs\C. Price Competitiveness\2018\07 July\DT\"
    fileName = Dir(directory & "*.xls")

    Application.DisplayAlerts = False

    Do While fileName <> ""
        Workbooks.Open directory & fileName
        fileName = Dir()
        ActiveWorkbook.CheckCompatibility = False
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Loop

    Application.DisplayAlerts = True
    app.Quit

End Sub

Upvotes: 1

Related Questions