Errore-runtime 70 - Autorizzazione negata

Question

Ciao,
eseguendo il codice sottostante ricevo il messaggio d'errore in oggetto, in particolare si blocca al punto
Open FileName For Input Lock Read As #filenum
Ho cercato in rete ma non ho trovato dove potrebbe essere l'errore nel codice che ho assemblato

La macro dal file di partenza "Invent_2024.xlsm" dovrebbe eseguire un'altra macro presente nel foglio "Proiezioni.xlsm" e copiare il risultato nel foglio "Daily" del file di partenza.
Un grazie in anticipo per qualsiasi aiuto.

Giovanni

Sub Copy_Paste_Below__Last_Cell()

'inserimento e formattazione riga Descrizione

    Dim lRow As Long 

    lRow = Range("A" & Cells.Rows.Count).End(xlUp).Row 

    Range("A" & lRow).Offset(2, 0).Value = "Descrizione:" 

    Range("A" & lRow).Offset(2, 2).Value = UCase(UserForm2.ComboBox1.Value) 

    Range("A" & lRow).Offset(2, 4).FormulaR1C1 = "=VLOOKUP(RC[-2],Tbl\_FDF,2)" 

    With Range("A" & lRow).Offset(2, 0).Resize(1, 6) 

        .Font.Name = "Calibri" 

        .Font.Bold = True 

        .Font.Size = 12 

    End With 

'verifica se foglio "Proziezioni.." è aperto

Dim wb As Workbook

Dim fileName As String

fileName = "C:\Users\gbian\Desktop\Proiezioni.xlsm"

If IsFileOpen(fileName) Then

    Application.Run "Proiezioni.xlsm!Foglio2.GenericoLast" 

    ThisWorkbook.Activate 

Else

    Set wb = Workbooks.Open("C:\Users\gbian\Desktop\Proiezioni.xlsm") 

    Application.Run "Proiezioni.xlsm!Foglio2.GenericoLast" 

    ActiveWindow.WindowState = xlMinimized 

    ThisWorkbook.Activate 

End If

''' copia range

Dim wsCopy As Worksheet

Dim wsDest As Worksheet

'Dim lCopyLastRow As Long

Dim lDestLastRow As Long

Set wsCopy = Workbooks("Proiezioni.xlsm").Worksheets("Daily") 

Set wsDest = Workbooks("Inv\_2024.xlsm").Worksheets("Daily") 

' lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row .

lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row    

wsCopy.Range("F13:P14").Copy 

With wsDest.Range("A" & lDestLastRow) 

    .PasteSpecial xlPasteFormats 

    .PasteSpecial xlPasteValues 

End With 

Workbooks("INV_2024.xlsm").Sheets("Daily").Activate

ActiveWindow.WindowState = xlMaximized

End Sub

Function IsFileOpen(FileName As String) ' da Internet

Dim filenum As Integer

Dim errnum As Integer

On Error Resume Next ' Turn error checking off.

filenum = FreeFile() ' Get a free file number.

' Attempt to open the file and lock it.

Open FileName For Input Lock Read As #filenum ' ERROR - ERROR

Close filenum ' Close the file.

errnum = Err ' Save the error number that occurred.

On Error GoTo 0 ' Turn error checking back on.

' Check to see which error occurred.

Select Case errnum

' No error occurred.

' File is NOT already open by another user.

Case 0

IsFileOpen = False

' Error number for "Permission Denied."

' File is already opened by another user.

Case 70

IsFileOpen = True

' Another error occurred.

Case Else

Error errnum

End Select

Answer 1

Comportamento strano e teoricamente impossibile, vista la presenza di un On Error Resume Next che serve proprio ad evitare il blocco.

La funzione che usi, e che uso anch'io da tempo, serve proprio a verificare se il file è aperto per evitare di riaprirlo, forzandone un'apertura che genera l'errore 70 il quale determina la restituzione del VERO.

Ciao.