[Excel] Macro - Verifica se un certo file è aperto

[Gourdo]

Buongiorno a tutti,
scrivo per la prima volta su questo forum dopo averne usufruito in lungo e in largo.
Ieri avevo un problema, ho trovato una soluzione, funziona... ma non capisco perché

Problema: Ho scritto una macro che mi esporta un foglio in pdf. Per necessità il nome del pdf è fisso, così come il percorso: ogni volta che avvio la macro il pdf DEVE essere sovrascritto. Ma se il file pdf risultato è aperto ciò non è possibile, per cui mi viene dato un errore e la macro si pianta.

Soluzione: inserire ad inizio macro una verifica dell'apertura del file. In questo caso ->Exit Sub

La soluzione l'ho trovata qui: https://support.microsoft.com/it-it/kb/291295, l'ho modificata minimamente secondo le mie esigenze (e scarse conoscenze) e tutto funziona perfettamente, ma non so perché... e quindi se in futuro dovrò rimetterci mano sono fregato.
Qualcuno di voi può spiegarmi per favore la logica di questa funzione? I commenti non mi sono molto di aiuto...

Codice: Seleziona tutto

Function IsFileOpen(filename As String)
    Dim filenum As Integer, 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
    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

End Function

La funzione viene usata in questo if:

Codice: Seleziona tutto

' Check se il file pdf è aperto, nel caso uscire dalla sub

    If IsFileOpen("C:\Windows\Temp\foglio.pdf") Then
       
        MsgBox "Chiudere il file PDF del Report per proseguire."
        Exit Sub
       
    End If


N.B.: sono autodidatta del tipo "devo fare questo, vado a cercare come si fa" e le mie basi di programmazione risalgono a fortran77.. per cui per favore siate pazienti.
N.B.: magari esiste un modo MOLTO più semplice di risolvere il problema e io non lo so... ben vengano altre soluzioni.
Grazie in anticipo.

[Anthony47]

Ciao Gourdo, benvenuto nel forum.

quindi se in futuro dovrò rimetterci mano sono fregato.

Quello che hai e' una "Funzione" che fa una cosa ben precisa, quindi la userai come e' tutte le volte che in futuro vuoi sondare se un file qualsiasi risulti "aperto" o "chiuso"; per dire che in futuro non ci dovresti mettere le mani.
Cio' detto, l'istruzione centrale del codice e'

Codice: Seleziona tutto

Open filename For Input Lock Read As #filenum


Questa prova ad aprire il file target (quello che vuoi sondare) in modalita' di lettura ma con divieto di lettura contemporanea da altri processi (Lock Read).
Se l'operazione riesce, significa che il file e' libero; se non riesce significa che e' gia' impegnato (codice di errore 70) o comunque che non e' libero (es errore 53 se il file e' inesistente).

Il limite di questa funzione e' che se il codice di errore e' diverso da 0 (file disponibile) o da 70 (file occupato) la funzione si blocca con un messaggio di errore, facendo di fatto abortire anche la macro principale (es se il file non esiste); personalmente io ne uso una variante, derivata sempre dallo stesso codice, che restituisce il codice di errore:

Codice: Seleziona tutto

Function FileStatus(filename As String) As Variant
'Check file status; codice di ritorno:
'0=file libero, 70=file occupato, 53=file non esiste
'76=path non esiste
'altri errori: da indagare
'
    Dim filenum As Integer, 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
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
FileStatus = errnum
End Function

La usi come la Function IsFileOpen, e in uscita controlli il codice di errore. Es

Codice: Seleziona tutto

fstat = FileStatus("C:\ppp.doc")

A te interessera' sondare se fstat e' pari a 0, per procedere; oppure se e' 70 (il file e' occupato) o al limite 76 (il percorso non esiste) che provocheranno un msgbox per l'utente.

Ciao

[Gourdo]

Grazie Anthony47 per la risposta e per il benvenuto!
Il mio "se in futuro dovrò rimetterci mano" era proprio per dire che se quella funzione mi da un errore non saprei dove andarlo a cercare.
E quello che scrivi ha confermato i miei timori. La tua modifica mi piace molto di più. Approvata.

Avevo intuito il funzionamento della funzione (scusa il gioco di parole), ovvero che "tentava" di aprire il file, ma non capivo la sintassi.
Ti chiedo un'altra cosa: cosa significa la riga filenum = FreeFile() ?

[Anthony47]

So che talvolta sembra piu' facile chiedere sul forum, ma certe cose invece e' meglio cercarle nell'help on line del programma, il Vba nel nostro caso, accessibile premendo F1. E' una miniera di informazioni e di esempi.
E cosi' avresti letto che l'Istruzione Freefile "Restituisce un valore Integer che rappresenta il successivo numero di file disponibile da utilizzare con l'istruzione Open"
Insomma e' utilizzato per avere il numero file da utilizzare nella successiva istruzione Open.

Ciao

[Gourdo]

Ciao,
avevo letto la guida, mi sa che mi sono spiegato male. Non ho proprio capito in base a cosa mi numera il file, e poi questo numero come viene letto da Open. Ma deriva da mie lacune di base, dovrei fare un corso completo.
Grazie dell'aiuto, funziona tutto benissimo

[d.cremaschi]

buongiorno, mi scuso per l'intromissione, vedo che stavate approfondendo esattamente quello che serve a me:
in un foglio tramite un Buttom salvo il foglio excel in formato pdf e lo vado a salvare in uno specifico percorso, quello che mi capita è che a volte mi viene generato un errore e solo dopo un po capisco che è perchè il file è già aperto, in teoria le strighe di codice che avete postato dovrebbero semplificarmi la vita dandomi la possibilità di creare degli avvisi in base al tipo di errore.
Qualcosa non quadra e sono sicuro che è colpa mia, ma mi sfugge la soluzione.
Anthony47 chiedo umilmente il tuo aiuto, e grazie per le dritte dell'altra volta sono state illuminanti.

[d.cremaschi]

Codice: Seleziona tutto

Function FileStatus(filename As String) As Variant                                  'funzione per recuperare lo stato di un dato file e avere un codice di ritorno come errore
                                                                                    'LA FUNZIONE IN QUESTIONE VIENE RIPRESA NELLA SUB CHE SEGUE
                                                                                    '0=file libero
                                                                                    '70=file occupato
                                                                                    '53=file non esiste
                                                                                    '76=path non esiste
                                                                                    'altri errori: da indagare
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next                                                            'attivare il controllo degli errori esterno
    filenum = FreeFile()                                                            'ottiene un numero di file libero
   
    Open filename For Input Lock Read As #filenum                                   'tentativo di aprire il file e leggerlo.
    Close filenum                                                                   'il file viene chiuso
    errnum = Err                                                                    'salvataggio del numero di errore verificato
    On Error GoTo 0                                                                 'attivare nuovamente il controllo degli errori
FileStatus = errnum
End Function

Private Sub CommandButtonPdf_Click()

ActiveSheet.Unprotect Password:="baileys76"                                         'tolgo momentaneamente la protezione al foglio per poter eseguire la macro

Dim PDFname As String                                                                'definisco che la variabile PDFname è una stringa
Dim PDFperc As String                                                                'definisco che la variabile PDFperc è una stringa
Dim pagP As String                                                                   'definisco che la variabile pagP come una stringa
Dim pagA As String                                                                   'definisco che la variabile pagA come una stringa

PDFname = ActiveSheet.Range("BS5").Value                                             'indico quale cella definisce la variabile PDFname
PDFperc = ActiveSheet.Range("BS3").Value                                             'indico quale cella definisce la variabile PDFperc

Dim Msg, Style, Title, Help, Ctxt, Response, MyString

fstat = FileStatus("PDFperc & PDFname.pdf")
Select Case fstat

Case 70
Msg = "Il file che vuoi salvare è già aperto, chiuderlo e riprovare"                 'definisce il messaggio.
Style = vbYesNo + vbCritical + vbDefaultButton2                                      'definisce i pulsanti.
Title = "A T T E N Z I O N E"                                                        'definisce il titolo.

Case 53
Msg = "Il file non esiste ancora, verra creato!"                                     'definisce il messaggio.
Style = vbYesNo + vbCritical + vbDefaultButton2                                      'definisce i pulsanti.
Title = "A T T E N Z I O N E"                                                        'definisce il titolo.

Case 76
Msg = "Il percorso di salvataggio del file non non è stato trovato!"                 'definisce il messaggio.
Style = vbYesNo + vbCritical + vbDefaultButton2                                      'definisce i pulsanti.
Title = "A T T E N Z I O N E"                                                        'definisce il titolo.

Case 0
Msg = "Pronto a salvare su file Pdf?"                                                'definisce il messaggio.
Style = vbYesNo + vbCritical + vbDefaultButton2                                      'definisce i pulsanti.
Title = "A T T E N Z I O N E"                                                        'definisce il titolo.
'Help = "DEMO.HLP"                                                                   'definisce il file della Guida (tralasciato)
'Ctxt = 1000                                                                         'definisce il contesto dell'argomento (tralasciato)
Response = MsgBox(Msg, Style, Title)                                                 'visualizza il messaggio
If Response = vbYes Then                                                             'in caso di scelta affermativa
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=PDFperc & PDFname, IncludeDocProperties:=True, IgnorePrintAreas:=True, From:=1, To:=1, OpenAfterPublish:=False

End If

End Select
ActiveSheet.Protect Password:="baileys76"                                           'rimetto la protezione al foglio così da impedirne cancellazione accidentale
End Sub


[Anthony47]

Mi pare che hai capito come usare la Function FileStatus, anche se non vedo le azioni a fronte dei casi 70, 76, 53 (e ci aggiungerei anche un Case Else, perche' non si puo' escludere uno stato diverso ancora).

Ciao

[d.cremaschi]

la function l'ho creata all'interno degli oggetti e nello stesso foglio che mi interessa, come puoi vedere scorrendo in giù il compilato, ho messo dei "case" che attivano dei messaggi a pannello, ma non funziona!, ad esempio, apro appositamente il file e e lanciando la macro "salva su pdf" non succede nulla, ne messaggi a pannello e eventualmente chiudendo il file, non mi viene nemmeno ricreato! come se tutto fosse bloccato in qualche stato strano, ora provo a mettere il "case else", magari mi rende un errore strano.
eventualmente se volessi leggere il codice dell'errore?

[Anthony47]

Non funziona perche' i Case <>0 non sono gestiti nella macro.
Limitati per prova a un semplice

Codice: Seleziona tutto

fstat = FileStatus("PDFperc & PDFname.pdf")
if fstat<>0 then
    msgbox("Errore " & Err.Description)
    Exit Sub
End If
Msg = "Pronto a salvare su file Pdf?"   
'etc etc Operazioni per salvare in pdf


Ciao

[d.cremaschi]

Codice: Seleziona tutto

Set oFSO = CreateObject("Scripting.FileSystemObject") 'setto l'oggetto
If oFSO.folderexists("N:\Exchange\CARICO ORE\") Then 'verifico la sua presenza e detto le condizioni, se esiste...


qualche tempo fa avevo trovato una strigna di codice che verificava la presenza di un dato percorso tipo quella postata di seguito, mi sembra di capire che non sono la stesa cosa! cosa pensi dell'alternativa? è gestibile allo stesso modo?

[Anthony47]

Questo pezzo di codice controlla solo se la Directory esiste; la Function FileStatus fa altre cose, compreso controllare se la directory esiste. Quindi se devi controllare lo status di un file usi Function FileStatus, se vuoi controllare se una directory esiste usi If oFSO.folderexists

Ciao

[d.cremaschi]

ho provato la tua soluzione gestendo con elseif gli stati e prima mi dice che il file non esiste, ok dico io se è questo l'allarme e premo ok lanciamo la stampa, ma poi esce un secondo messaggio di errore senza codice???

[d.cremaschi]

con il tuo codice di verifica mi da in messaggio solo di errore senza descrizione, mentre se tolgo il .Description, mi da errore 0.
questo dovrebbe significare che il file è libero e posso sovrascriverlo, perchè non mi parte il salvataggio?

[Anthony47]

Il codice msgbox("Errore " & Err.Description) e' sbagliato perche' in quella posizione il valore "Err" non e' piu' disponibile; avrei dovuto invece usare

Codice: Seleziona tutto

msgbox("Errore " & fstat)


Ora io direi una cosa:
Diamo per scontato che la Function FileStatus, col codice descritto nel post del 12-01-2016, sia funzionante e faccia quel che dichiara di fare.
Tu, sulla base di quanto ti dice quella function che cosa vuoi fare?
-se il file e' libero?
-se il file non e' libero?
-se il path non esiste?

Ciao

[d.cremaschi]

Codice: Seleziona tutto

Private Sub CommandButtonPdf_Click()

'ActiveSheet.Unprotect Password:="baileys76"                                         'tolgo momentaneamente la protezione al foglio per poter eseguire la macro

Dim PDFname As String                                                                'definisco che la variabile PDFname è una stringa
Dim PDFperc As String                                                                'definisco che la variabile PDFperc è una stringa
Dim PDFdef As String
Dim pagP As String                                                                   'definisco che la variabile pagP come una stringa
Dim pagA As String                                                                   'definisco che la variabile pagA come una stringa

PDFname = ActiveSheet.Range("BS5").Value                                             'indico quale cella definisce la variabile PDFname
PDFperc = ActiveSheet.Range("BS3").Value                                             'indico quale cella definisce la variabile PDFperc
PDFdef = "PDFperc & PDFname.pdf"
fstat = FileStatus(PDFdef)

If fstat = 0 Then

Dim Risp0 As Integer
Risp0 = MsgBox("Pronto a salvare su file Pdf?", vbYesNo, vbQuestion, "A T T E N Z I O N E") 'definisco la struttura della MsgBox
If Risp0 = vbYes Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=PDFperc & PDFname, IncludeDocProperties:=True, IgnorePrintAreas:=True, From:=1, To:=1, OpenAfterPublish:=False
ElseIf Risp0 = vbNo Then
Exit Sub
End If

ElseIf fstat = 70 Then

Dim Risp70 As Integer
Risp70 = MsgBox("Il file che vuoi salvare è già aperto, chiuderlo e riprovare", vbRetryCancel, "A T T E N Z I O N E") 'definisco la struttura della MsgBox
If Risp70 = vbRetry Then
Exit Sub
CommandButtonPdf = True
ElseIf Risp70 = vbCancel Then
Exit Sub
End If

ElseIf fstat = 53 Then

Dim Risp53 As Integer
Risp53 = MsgBox("Il file non esiste ancora, verra creato!", vbOK, "A T T E N Z I O N E") 'definisco la struttura della MsgBox
If Risp53 = vbOK Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=PDFperc & PDFname, IncludeDocProperties:=True, IgnorePrintAreas:=True, From:=1, To:=1, OpenAfterPublish:=False
End If

ElseIf fstat = 76 Then

Dim Risp76 As Integer
Dim Risp76No As Integer
Risp76 = MsgBox("Il percorso di salvataggio del file non è stato trovato!", vbOK, vbQuestion, "A T T E N Z I O N E") 'definisco la struttura della MsgBox
If Risp76 = vbOK Then
Exit Sub
Else
Risp76No = MsgBox("Errore esterno a quelli riconosciuti & vbNewLine & Errore " & Err, vbOK, vbQuestion, "A T T E N Z I O N E") 'definisco la struttura della MsgBox
If Risp76No = vbOK Then
Exit Sub
End If
End If

End If


'ActiveSheet.Protect Password:="baileys76"                                           'rimetto la protezione al foglio così da impedirne cancellazione accidentale

End Sub


purtroppo avevo già inviato il messaggio, riguardando mi sono accorto che il codice non era corretto, con calma mi ci sono messo e l'ho corretto, sembra funzionare, solamente che con questa nuova gestione lui dice che il file non esiste e che verrà creato "stato 53", quello che non capisco è se:
a. il sistema si trovi in quello stato perchè non riconosce il nome del file e la sua locazione?(bada, l'espressione è la stessa che uso quando genero il file);
b. il file lui lo crea ma mi da sempre lo stesso codice, nonostante il file esista, ho provato anche a cancellarlo dalla directory ma lui non ne vuole sapere, sempre "stato 53" (o meglio in questo caso è giusto che mi dia questo stato, il file effettivamente non esiste) ho provato anche a inserire una variabile PDFdef che rappresenta il nome del file e il percorso completo (mi sono detto magari gli fa schifo come era scritto in precedenza);
c. se apro il file pdf, nuovamente lui va nello "stato 53" e poi logicamente mi viene generato un errore in quanto dovrebbe creare un file che è già aperto altrove!!
d. analizzando e rileggendo quello che ti ho appena scritto mi sto convincendo che il problema (fermo restando che la funzione FileStatus faccia quello che deve!) che il problema sia nel nome del file o nella sua struttura.

Rispondendo alla tua domanda, io vorrei strutturare il file in modo che mi definisca che cosa sta succedendo nelle varie situazioni in modo tale che se non sono io ad usarlo chiunque mi possa dire: "guarda che mi sta dando questo errore, cosa devo fare!?"

Spero di essere stato abbastanza chiaro.
Grazie mille per l'aiuto

[d.cremaschi]

Codice: Seleziona tutto

PDFname = ActiveSheet.Range("BS5").Value                                             'indico quale cella definisce la variabile PDFname
PDFperc = ActiveSheet.Range("BS3").Value                                             'indico quale cella definisce la variabile PDFperc
fstat = FileStatus(ActiveSheet.Range("BE6"))

If fstat = 0 Then

Dim Risp0 As Integer
[color=#0000FF]Risp0 = MsgBox("Pronto a salvare su file Pdf?", vbYesNo, vbQuestion, "A T T E N Z I O N E") 'definisco la struttura della MsgBox[/color]
If Risp0 = vbYes Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=PDFperc & PDFname, IncludeDocProperties:=True, IgnorePrintAreas:=True, From:=1, To:=1, OpenAfterPublish:=False
ElseIf Risp0 = vbNo Then
Exit Sub
End If

ElseIf fstat = 70 Then


Ok problema riscontrato nel riconoscimento della variabile, adesso compongo la stringa completa nel foglio e la leggo all'interno di un'unica cella, infatti ora il messaggio di errore è cambiato, ma mi viene restituito l'errore 5 su questa stringa!, ci vedi qualcosa di anomalo?

[d.cremaschi]

ho risolto! errore di sintassi, funziona! mi rimane solo il dubbio del perchè non accettasse il fstat=FileStatus (xxxxx) come lo avevo impostato io!!!!!
grazie comunque per la pazienza e l'aiuto

[Anthony47]

Lieto che hai risolto con un po' di ingegno...
La risposta ai quesiti sta in quelle cose che non si vedono:
-che cosa c'e' scritto in BS5 e BS3?
In prima battuta direi che BS3 contiene una directory, tipo " D:\PIPPO\PLUTO\", compreso lo \ finale; se mancasse lo \ allora quando a occhio vai a cercare il file non lo troveresti nel percorso giusto, ma lo troveresti nel percorso "a monte" (D:\PIPPO, nell'esempio) col nome sbagliato.
In BS5 temo che tu abbia il nome SENZA l'estensione ".pdf"

Perche' quando vai a creare il file con ActiveSheet.ExportAsFixedFormat allora .pdf viene aggiunto di default, mentre per filesystemObject una cosa e' il file NomeFile un'altra e' NomeFile.pdf

Se vogliamo essere a prova di errore allora dobbiamo varire qualcosa... Vedi le righe marcate *** nel codice che segue.
Mi sono anche permesso di rivedere un attimo l'architettura complessiva della macro, che secondo me potrebbe avere questo aspetto:

Codice: Seleziona tutto

Private Sub CommandButtonPdf_Click()
'
'ActiveSheet.Unprotect Password:="baileys76"
'
Dim PDFname As String
Dim PDFperc As String
Dim PDFdef As String
Dim pagP As String
Dim pagA As String
Dim Rispo
'
PDFname = ActiveSheet.Range("BS5").Value
If Right(PDFname, 4) <> ".pdf" Then PDFname = PDFname & ".pdf"  '***
PDFperc = ActiveSheet.Range("BS3").Value
If Right(PDFperc, 1) <> "\" Then PDFperc = PDFperc & "\"        '***
PDFdef = "PDFperc & PDFname.pdf"

reTry:
fstat = FileStatus(PDFdef)
If fstat = 0 Or fstat = 53 Then 'pronti per scrivere il pdf
    If fstat = 0 Then
        msg = "Pronti ad AGGIORNARE il file pdf esistente?"
    Else
      msg = "Pronti per creare il NUOVO file pdf?"
    End If
    Rispo = MsgBox(msg, vbYesNo, vbQuestion, "A T T E N Z I O N E")
    If Rispo = vbYes Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFperc & PDFname, IncludeDocProperties:=True, IgnorePrintAreas:=True, From:=1, To:=1, OpenAfterPublish:=False
    ElseIf Risp0 = vbNo Then
        Exit Sub
    End If
ElseIf fstat = 70 Then      'File aperto
    Rispo = MsgBox("Il file che vuoi salvare è già aperto." & vbCrLf & _
       "Chiuderlo e riprovare, oppure Annulla per terminare", vbRetryCancel, "A T T E N Z I O N E")
    If Rispo = vbRetry Then 'scelta Riprova
        GoTo reTry
'        CommandButtonPdf = True
    Else                    'scelta Annulla
        Exit Sub
    End If
ElseIf fstat = 76 Then      'missing directory
    MsgBox ("Il percorso di salvataggio del file non è stato trovato, il salvataggio non sara' effettuato")
    Exit Sub
Else                        'altri errori
    MsgBox ("Errore esterno a quelli riconosciuti & vbNewLine & Errore " & fstat & _
       vbCrLf & "Il salvataggio non sara' effettuato")
    Exit Sub
End If
End Sub


Le istruzioni marcate *** sono aggiunte per convivere con vari contenuti delle celle BS3 e BS5; il resto e' la tua macro con qualche arrangiamento diverso.

Ciao

[d.cremaschi]

ottimo come sempre, è un piacere imparare da te, sono riuscito a leggere e comprendere le modifiche che hai apportato senza grossi problemi, ne ho ancora di strada da fare per semplificare i miei codici, l'importante è apprendere e comprendere. Comunque nella sua "semplicità" sono felice di quello che sono riuscito a fare, questo file mi aiuterà molto a verificare con facilità le voci della busta paga!! e il lavoro di compilazione delle ore mensili.
GRAZIE ANCORA DELLE ILLUMINAZIONI!!!!!