Excel freezes when using VBA to open a workbook from network

Question

I have an odd problem. The cabinetry business I work for uses an Excel workbook for pricing. We price the job in sections which are saved in multiple workbooks, and after we're done we have a macro which compiles the prices into one file. All our files are stored on a NAS which is accessed through the network.

Here's where it gets strange. Occasionally, when compiling the prices, the macro will freeze while opening the source workbook. No error, it just gets stuck loading. I can tell by walking through the code that it does open the workbook, but it instantly gets stuck. I've tried it with and without Application.EnableEvents enabled, and neither one works. It's being opened as read-only, with update links turned off.

On our pricing worksheet we have 2 buttons, one which names and saves the file, the other which does the same plus resetting the workbook for the next section of the job. The save portions of both macros are nearly identical, the main difference being the reset portion. The problem I described only happens when I first use the "Save & Reset" button, then reprice it and use the "Save/Save As" button. The first workbook works fine during compilation, the second freezes it. If I open the problem workbook and re-save it the problem goes away. I've been hammering my head against this one all morning and I have yet to figure out what's going on. Any direction would be greatly appreciated!

Code

Save/Save As macro

Dim FldrName, ThisFile As String

ThisFile = Sheet3.Range("FileName")
FldrName = Sheet3.Range("FolderName")

Application.DisplayAlerts = False
Application.EnableEvents = False

ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\" & FldrName & "\" & _
ThisFile & ".xlsm", 52

Application.DisplayAlerts = True
Application.EnableEvents = True

Save and Reset macro

Dim FldrName, ThisFile As String
Dim Ans As Integer

'This section is identical to the previous macro

ThisFile = Sheet3.Range("FileName")
FldrName = Sheet3.Range("FolderName")

Application.DisplayAlerts = False
Application.EnableEvents = False

ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\" & FldrName & "\" & _
ThisFile & ".xlsm", 52

Application.DisplayAlerts = True
Application.EnableEvents = True


Before  'A simple sub which turns off EnableEvents, ScreenUpdating, and DisplayAlerts

ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\- IP Proposal\QCT Proposal" & _ 
".xlsm", 52  'Saves as a copy to keep the original from being changed

'This portion resets the values on the workbook

Ans = MsgBox("Reset Specs?", vbYesNo + vbQuestion)

If Ans = 6 Then
    With Sheet3
        .Range("ChangeToNA").Value = "Not applicable"
        .Range("ChangeToChooseFinish").Value = "CHOOSE FINISH"
        .Range("ChangeToYes").Value = "Yes"
        .Range("ChangeToNo").Value = "No"
        .Range("ChangeToStandard").Value = "Standard"
        .Range("JIEmptyThese").Value = ""
        .Range("CMAP").Value = 50
    End With
Else
    Sheet3.Range("JIEmptyWhenNotReset").Value = ""
End If

With Sheet11
    .Range("DCEmptyThese").Value = ""
    .Range("ChangeTo1").Value = "1"
    .Range("ChangeTo4").Value = "4"""
    .Range("MiscCrown").Value = "(Misc. Crown)"
    .Range("MiscMolding").Value = "(Misc. Molding)"
    .Range("ChangeToShipV").Value = "(Ship/V)"
    .Range("ChangeTo8Dollars").Value = 8
End With

With Sheet2
    .Range("IEmptyThese").Value = ""
    .Range("DeleteValidationInThese").Validation.Delete
End With

Sheet2.Unprotect
Application.Goto Sheet2.Range("a68"), True
Sheet2.Range("b82").Select

Application.Goto Sheet11.Range("a1"), True
Sheet11.Range("b4").Select

Sheet3.Unprotect
Application.Goto Sheet3.Range("DelDrop").Offset(-1, -2), True
Sheet3.Range("DelDrop").Select

After  'Mirrors the Before sub

Compilation Macro

Dim IWB As Workbook
Dim IWBJ, IWBI As Worksheet
Dim FldrName, JobFldr, FileName As String

Before

JobFldr = Sheet1.Range("FolderName")
FldrName = "\\qctnas\Google Drive\Production\" & JobFldr & "\"

FileName = Dir(FldrName & "*QCT Proposal*.xlsm")

Do While FileName <> ""
    Set IWB = Workbooks.Open(FldrName & FileName, False, True)
    Set IWBI = IWB.Sheets("Invoice")
    Set IWBJ = IWB.Sheets("Job Info")

    'Copy info

    FileName = Dir()
Loop

After

Answer 1

Cleaning the below code fixed the issue. Not sure why.

Changed this:

On Error Resume Next
ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\" & FldrName & "\" & _
ThisFile & ".xlsm", 52
If ThisWorkbook.Saved = False Then ThisWorkbook.Save
On Error GoTo 0

to this:

ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\" & FldrName & "\" & _
ThisFile & ".xlsm", 52