Looppare un ciclo di controlli

[Angelo24Partecipante Angelo24]

Buongiorno a tutti!

Ho un codice, perfezionato da voi  , relativo a un file DataEntry dal quale si inviano dati ad un altro file (DataBase) in multiutenza.

Il codice del DataEntry al momento dell'invio dei dati (TEMPO ZERO) controlla che il database non sia in uso, quindi sia chiuso.

1. Se è chiuso appare il messaggio "Vuoi proseguire?" e cliccando SI, fa tutte le operazioni che deve fare, poi apre il DataBase (TEMPO UNO), trascrive i dati, lo salva e lo chiude.

2. Se è aperto appare il messaggio "Il file di destinazione è al momento in uso. Riprova più tardi". L'utente cliccando OK, attende qualche secondo che il file in uso si chiuda, poi dà di nuovo l'invio e se il file di destinazione è chiuso appare il messaggio del punto 1.

Funziona perfettamente, ma purtroppo ha un (impensabile) punto debole.

Infatti, ipotizziamo che utente 1 e utente 2 diano l'invio più o meno in contemporanea, che "passi" per primo l'utente 1, che quindi copia i dati dal DataEntry, poi apre il DataBase, ecc.

L'utente 2 dà l'invio un attimo dopo, ma non trova il file aperto come dovrebbe! perchè dà l'invio in quel maledettissimo lasso di tempo che passa fra il TEMPO ZERO e il TEMPO UNO indicati sopra. Quindi appare il messaggio "Vuoi proseguire?", l'utente clicca SI, ma invece il DataBase è aperto e si incasina la cosa.

Infatti si apre il DataBase sullo schermo (è l'utente non deve vedere il DataBase) e la maschera "Salva con nome" del file "Copia di DataBase".

Ora, a meno che non abbiate una soluzione migliore, io pensavo se poteste fare in modo che dopo il messaggio "Vuoi proseguire?", cliccandi SI, non siano inviati i dati, ma si faccia un altro controllo identico al primo, che se trova il DataBase chiuso invia i dati, mentre se lo trova aperto, apra il messaggio "Il file di destinazione è al momento in uso. Riprova più tardi", l'utente clicca OK e poi riprova, e il ciclo ricomincia, una loop praticamente.

Grazie mille!

 

'---

Option Explicit


Sub TestFileOpened()
'Salva il file
ActiveWorkbook.Save
'Fine salva il file
   Const sFileDataBaseFullName As String = "\\B1110160\db.Orientamento\DataBase.xlsx"
   
   Dim WbDB As Workbook
   Dim bDbIsOpen As Boolean
   
   On Error GoTo GestisciErrori
   With Application
      .Calculation = xlCalculationManual
      .EnableEvents = True
      .ScreenUpdating = True
   End With
   
   With ThisWorkbook
      With .Worksheets("Preparazione invio")
         If .Range("A7") > 0 Then
            MsgBox "Attenzione! Compilare tutti i campi obbligatori. Campi non compilati: " & .Range("A7"), vbExclamation, "Campi obbligatori mancanti"
            With Application
      .Calculation = xlCalculationAutomatic
      .EnableEvents = False
      .ScreenUpdating = False
   End With
            Exit Sub
         End If
      End With
   End With
 
    ' Testa se il file dataBase è aperto (macro attiva).
    If IsFileOpen(sFileDataBaseFullName) Then
        ' Mostra msg se il file è in uso.
        MsgBox "Il file di destinazione è al momento in uso. Riprova più tardi"
        '
    Else
        ' Mostra msg se il file è disponibile.
        If MsgBox("Vuoi proseguire?", vbOKCancel) = vbCancel Then Exit Sub
        ' Apri data base.
        Set WbDB = Workbooks.Open(sFileDataBaseFullName)
        ' Salva il dataBase
        ' WbDB.Save
        bDbIsOpen = True
   End If
   
   
   If bDbIsOpen Then
      
      With ThisWorkbook
         .Activate
         .Worksheets("Scheda").Activate
         .Sheets("Preparazione invio").Range("B5:BB5").Copy
      End With
      
      With WbDB
         With .Worksheets(1)
            With .Range("B5").End(xlDown).Offset(1)
               .PasteSpecial Paste:=xlPasteAllUsingSourceTheme, _
                             Operation:=xlNone, _
                             SkipBlanks:=False, _
                             Transpose:=False
               .PasteSpecial Paste:=xlPasteValues, _
                             Operation:=xlNone, _
                             SkipBlanks:=False, _
                             Transpose:=False
                             Application.CutCopyMode = False
         End With ' .Range("C5").End(xlDown).Offset(1)
              Application.GoTo .Range("A1")
         End With '.Worksheets(1)
         ' salva una copia del database. IL "CALL" seguente se non commentato richiama il back-up in altra cartella
         'Call SalvaCopiaDataBase(WbDB)XXX COMMENTATO (salvataggio back-up in altra cartella)
         ' chiude salvando la cartella di lavoro
         .Close True
      End With 'WbDb
    End If
RiprendiErrori:
   With Application
      .Calculation = xlCalculationAutomatic
      .EnableEvents = True
      .ScreenUpdating = True
   End With
       
    Exit Sub
GestisciErrori:
    MsgBox "Si è verificato un errore VBA!" & vbNewLine & _
           "Errore n. " & Err.Number & vbNewLine & _
           Err.Description, vbCritical, "Errore VBA"
    Resume RiprendiErrori
End Sub
'Sub SalvaCopiaDataBase(WbToCopy As Workbook) XXX COMMENTATO (salvataggio back-up in altra cartella)
   'Const sPercorsoSalvataggio As String = "\\B1110160\\db.Orientamento.Backup\" XXX COMMENTATO (salvataggio back-up in altra cartella)
   'Dim sDataOraSalvataggio As String XXX COMMENTATO (salvataggio back-up in altra cartella)
  'Dim sEst As String XXX COMMENTATO (salvataggio back-up in altra cartella)
  'Dim sNomeFileCopia As String XXX COMMENTATO (salvataggio back-up in altra cartella)
  'sDataOraSalvataggio = Format(Now, "_yyyymmdd_hhmmss") XXX COMMENTATO (salvataggio back-up in altra cartella)
  'With WbToCopy XXX COMMENTATO (salvataggio back-up in altra cartella)
     ' sEst = Mid(.Name, InStrRev(.Name, ".")) XXX COMMENTATO (salvataggio back-up in altra cartella)
     ' sNomeFileCopia = Replace(.Name, sEst, sDataOraSalvataggio & sEst) XXX COMMENTATO (salvataggio back-up in altra cartella)
      '.SaveCopyAs sPercorsoSalvataggio & sNomeFileCopia XXX COMMENTATO (salvataggio back-up in altra cartella)
   'End With XXX COMMENTATO (salvataggio back-up in altra cartella)
'End Sub XXX COMMENTATO (salvataggio back-up in altra cartella)


Public Function IsFileOpen(FileName As String) As Boolean
'----------------------------------------------------------------------'
'Questa funzione determina se un file è aperto da qualsiasi programma. '
'Restituisce vero o falso                                              '
'----------------------------------------------------------------------'
  Dim FileNum As Long
  Dim ErrNum As Long
  On Error Resume Next
  If FileName = vbNullString Then
      IsFileOpen = False
      Exit Function
  End If
  If Dir(FileName) = vbNullString Then
      IsFileOpen = False
      Exit Function
  End If
  FileNum = FreeFile()
  Err.Clear
  Open FileName For Input Lock Read As #FileNum
  ErrNum = Err.Number
  On Error GoTo 0
  Close #FileNum
  Select Case ErrNum
    Case 0
        IsFileOpen = False
    'Case 70
    '    IsFileOpen = True
    Case Else
        IsFileOpen = True
  End Select
End Function

'---

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Angelo24 ha scritto:

a meno che non abbiate una soluzione migliore

Vorrei proporre di inserire forzatamente un tempo di attesa (poniamo un secondo? due secondi?), bloccando l'applicazione Excel prima che l'utente tenti di accedere al file (cioè se non mi ricordo male prima di  

If IsFileOpen(sFileDataBaseFullName) Then

In questo modo il "maledettissimo lasso di tempo che passa fra il TEMPO ZERO e il TEMPO UNO" è lungo abbastanza da fare in modo che il primo utenti apri il file e gli dia il tempo di essere "locked" rispetto al secondo utilizzatore.

Naturalmente così si allunga il tempo di attesa che un utente deve sopportare, ma dovrebbe garantire la tranquillità di apertura esclusiva.

Per forzare un tempo di attesa io userei l'API Sleep, ma credo che anche Application.Wait possa funzionare bene. L'istruzione va messa prima dell'If citato sopra.

[Angelo24Partecipante Angelo24]

Un immenso grazie vecchio frac!

Il tempo di attesa non è assolutamente un problema.

   Solo che l'API Sleep o l'Application.Wait non so proprio cosa siano. Potresti inserirli tu nel codice per favore?   

[patelModeratore patel Karma: 51 pts]

Angelo, capisco benissimo che tu non sappia cosa siano, ma non potresti documentarti in proposito ?

[Angelo24Partecipante Angelo24]

Ok vecchio frac, ho fatto qualche ricerca e ho trovato qualcosa su application.Wait.

Quindi aggiungo 3 secondi inserendo dove hai indicato:

Application.Wait Now + TimeValue ("00:00:03")

È  giusto?

[Angelo24Partecipante Angelo24]

Patel hai ragione, ma se solo tardavi qualche secondo a scrivere non mi beccavo questa meritata osservazione come puoi vedere ...

Potevi tardare un po mannaggia!

Comunque sono d'accordo con te.

[Angelo24Partecipante Angelo24]

Carissimo vecchio frac ho provato, mettendo una pausa di ben 4 secondi.   

Ma purtroppo come pensavo, non va, facendo le prove vedo in diretta il problema e da quello che vedo, così facendo il "maledettissimo lasso di tempo" viene solo spostato in avanti.

I due utenti viaggiano in parallelo, quello che fa l'uno, fa l'altro, secondo me è proprio questa sincronia che deve essere spezzata.

Secondo me si spezza bloccando il secondo utente che chiede strada nel modo che tornerei a sponsorizzare:

<em>Fare in modo che dopo il messaggio "Vuoi proseguire?", cliccando SI, non siano inviati i dati, ma si faccia un altro controllo identico al primo, che se trova il DataBase chiuso invia i dati, mentre se lo trova aperto, apra il messaggio "Il file di destinazione è al momento in uso. Riprova più tardi", l'utente clicca OK e poi riprova, e il ciclo ricomincia, un loop praticamente.</em>

Sempre naturalmente che non esista una soluzione migliore ...   

Cosa ne pensi?

Grazie come sempre!

[Angelo24Partecipante Angelo24]

Io penso che anche la mia proposta non risolva niente.  Va avanti tutto in parallelo e si sposta solo il problema più avanti.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Angelo24 ha scritto:

ho fatto qualche ricerca e ho trovato qualcosa su application.Wait.

Io di solito faccio così, quando non conosco un metodo o una proprietà: apro la finestra immediata (Ctrl-G nell'editor), scrivo la proprietà (in questo caso Application.Wait) e premo F1 per avere la guida. Quando voglio info maggiori allora mi affido a S. Google 🙂

Tornando al merito, non riesco a capire come due utenti che lavorano in tempi diversi possano accedere in modo così sincronico nel medesimo spazio temporale al file. E' molto difficile.

Fai un'altra prova, se possibile, dicendo esplicitamente alla macro di uscire se il file è in uso.

Quindi aggiungi un salto a RiprendiErrore dopo il msgbox:

' Mostra msg se il file è in uso. MsgBox "Il file di destinazione è al momento in uso. Riprova più tardi"
GoTo RiprendiErrori

[Angelo24Partecipante Angelo24]

Prove posso farne quante ne voglio!

Proverò il tuo suggerimento. 

E' vero che è un caso molto improbabile, infatti è successo durante le prove, dove forziamo la concorrenza. Non siamo ancora operativi.

Ma essendo importante non posso permettermi purtroppo di rischiare che succeda e magari non ci sono e si blocca tutto.

Devo riuscire ad evitarlo se riesco. Altrimenti dovrò fare una "linea dedicata" per ogni operatore, per contrastare la concorrenza, e poi assemblare i vari Database, ma non è il massimo. E' il mio piano B.   

Domani provo la tua soluzione. Grazie.

Un saluto!

 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Avrei un piano C 🙂 Ho capito che ci sono più utenti con più copie del file che agiscono in modo concorrente sul medesimo file database.

Il punto debole è IsFileOpen. Allora lo aggiriamo. Quando l'utente avvia la propria macro dal proprio Excel, scrive un semplice file di testo vuoto in una cartella condivisa, accessibile a tutti (va benissimo quella del file database: "\\B1110160\db.Orientamento\").

Questo file di testo vuoto dal nome convenzionale (ad esempio "stop.txt") sarà il semaforo che dirà agli altri utilizzatori se proseguire o no. Infatti prima di scrivere questo file di testo vuoto, sarà necessario un check: se il file esiste, attendi finchè il file non esiste più. La verifica su un file invece che su un file Excel aperto o no è molto più rapida.

Quindi:

1) lancio la macro

2) eseguo Do Loop finchè il file stop.txt esiste (utilizziamo Dir("file.txt") per verificare se il file c'è o no)

3) appena vedo che il file txt non esiste, lo creo (con Open "stop.txt" For Output As #1) e quindi mi prenoto. E' come prendere il biglietto col numero in farmacia 🙂

4) quando finisco tutto, poco prima di uscire (e comunque in qualsiasi punto poco prima di uscire dalla sub: dove c'è un exit insomma), cancello il file di testo con Kill.

In teoria può reggere 🙂

 

[Angelo24Partecipante Angelo24]

Anche per me!

Hai centrato il problema.  

Solo che inserire quello che hai suggerito nel codice è decisamente oltre le mie capacità. 

Se hai tempo grazie se no ho sempre il mio piano B.

Ciao!

 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Angelo24 ha scritto:

è decisamente oltre le mie capacità

Ma no dai veramente? devi solo creare un file di testo e impostare un do loop che verifica se esiste. Tutto qui.

Appena posso vedo di scriverti lo scheletro del codice ma credimi che è alla tua portata se sei arrivato fin qui 🙂

[Angelo24Partecipante Angelo24]

 Grazie per la fiducia 

Ma se sono arrivato fin qui è  perche sono un drogato di Excel. Lì sì faccio grandi cose.  Poi una cosa tira l'altra e registro macro anche complesse.

Ma poi se subentra il VBA ...  e rallento molto. Infatti il resto l'hai fatto tu e prima di te un'altro esperto.   

Dovrei avere il tempo di dedicarmici ...

[Autore]

Articoli