Crea MACRO per cartella Excel "LEGGI FILE PDF PROTETTO SU CD

[zanatta77]

Salve a tutti
Sto cercando di realizzare una macro per leggere un CD masterizzato con file.pdf contenuti in una cartella.rar protetta da chiave.
Quello che vorrei realizzare in sintesi è:
Esempio ; scrivendo in una cella carico1 in altra cella se trovato il collegamento ipertestuale lampeggia e premendolo mi va a LEGGERE un file pdf contenuto in un CD all'interno di una cartella.rar con chiave critografata.
In modo da leggere i file contenuti nella cartella.rar protetta, solo dal file excel d'interesse evitando letture dirette dal CD.
Se qualcuno volesse aiutarmi grazie !!
Ecco a che punto sono ....


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Cells(5, 3) = "carico1" Then
Range("G2") = "Documento visionabile"
Foglio1.Hyperlinks.Add anchor:=Range("G2"), Address:="D:\ARCHIVIO CARICHI ANNO 2011\CONTENITORE CARICHI 2011/1 CM di carico.pdf"
ElseIf Cells(5, 3) = "carico2" Then
Range("G2") = "Documento visionabile"
Foglio1.Hyperlinks.Add anchor:=Range("G2"), Address:="D:\ARCHIVIO CARICHI ANNO 2011\CONTENITORE CARICHI 2011/2 CM di carico.pdf"
ElseIf Cells(5, 3) = "carico3" Then
Range("G2") = "Documento visionabile"
Foglio1.Hyperlinks.Add anchor:=Range("G2"), Address:="D:\ARCHIVIO CARICHI ANNO 2011\CONTENITORE CARICHI 2011/3 CM di carico.pdf"
Else
Hyperlinks.Delete
Range("G2") = "DOCUMENTO NON ELABORATO"
End If
If Range("C5").Value >= "carico1" Then
On Error Resume Next
lampeggiaON "carico", "G2"
Else
On Error Resume Next
lampeggiaOFF "carico", "G2"
End If
End Sub



Ho provato anche questo riportato sotto ad inserirlo ma alla fine mi estrae solo il file .rar lasciandolo estratto mentre a me occorre solo che lo legga

Dim WinRarPath As String 'WinRar.exe location
Dim RarIt As String 'Command line instruction
Dim SourceDir As String 'The source directory
Dim SourceRarFile As String 'The source file
Dim Source As String 'The combined Rar from path(s)(FROM)
Dim Dest As String 'The combined unRar to path (TO)
WinRarPath = "C:\Program Files\WinRar\"
If Dir(WinRarPath, vbDirectory) = "" Then
MsgBox "WinRar is not installed in the default directory." _
& Chr$(13) & "Archiving of files will not be possible."
Exit Sub
End If
SourceDir = "D:\ARCHIVIO CARICHI ANNO 2011"
SourceRarFile = "CONTENITORE CARICHI 2011.Rar"
Source = SourceDir & "\" & SourceRarFile
If InStr(1, Source, " ", vbTextCompare) <> 0 Then Source = Chr(34) & Source & Chr(34)
Dest = "D:\ARCHIVIO CARICHI ANNO 2011\"
If Dir(Dest, vbDirectory) = "" Then MkDir Dest
If InStr(1, Dest, " ", vbTextCompare) <> 0 Then Dest = Chr(34) & Dest & Chr(34)
RarIt = Shell _
(WinRarPath & "WinRar.exe e " & Source & " " & Dest, vbNormalFocus)

[Anthony47]

Ciao zanatta77, benvenuto nel forum
Come programma di compressione /decompressione uso 7-Zip, che consente anche l' invio di comandi tramite una command line; ad esempio con queste istruzioni vba si puo' estrarre il contenuto di una cartella protetta:

Codice: Seleziona tutto

'PARAMETRI DA PERSONALIZZARE
myZipProg = """C:\Program Files (x86)\7-Zip\7z.exe"""
myZipFile = """C:\Users\UTENTE\Documents\NomeFile.zip"""
myExtrDir = "C:\PROVA\7-zip\"
myZipPassw = "12345678"
'Fine parametri
'
Respp = Shell(myZipProg & " e " & myZipFile & " -o" & myExtrDir & " -p" & myZipPassw, 1)
myStart = Timer
Do
    DoEvents
    If Timer > myStart + 10 Or Timer < myStart Then Exit Do
Loop


Nel primo blocco di istruzioni ci sono i parametri dell' unzipping:
-Il percorso e il nome del file 7z.exe (versione Command Line del 7-Zip)
-Il percorso e nome del file da esaminare
-La directory in cui saranno estratti i file (target directory)
-La password con cui l' archivio e' protetto
Personalizzando le righe, rispetta tassativamente la sintassi indicata.
L' istruzione Shell lancera' il programma che estrarra' i file "in modo asincrono" rispetto alle istruzioni vba; pertanto ho inserito un delay di 10 secondi prima di procedere oltre.
Ci sarebbero modi piu' eleganti per determinare se l' estrazione e' finita; ad esempio controllare che il "pid" che l' istruzione Shell mette nella variabile Respp scompaia dai running processes.
Non mi e' nemmeno chiaro se devi continuamente unzippare il tuo archivio, o se fatto una volta va bene per tutte le occasioni successive fino alla chiusura del file. A seconda del caso dovrai lanciare in continuazione il codice che unzippa (vedi sopra; dovrai pero' inserire le istruzioni che prima svuotano la target directory); oppure lo lancerai all' apertura del workbook (sempre previo svuotamento della target directory) e poi all' occorrenza vai a prelevare uno degli N file che sono stati estratti dall' archivio zippato.
Se vuoi lavorare con un hyperlink allora io userei l' evento "Worksheet_FollowHyperlink" per procedere nel modo piu' appropriato indipendentemente dall' hyperlink impostato.

Ricorda che puoi aprire il file pdf prescelto con un altro comando Shell, del tipo

Codice: Seleziona tutto

    RetVal = Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe " & PathNName, 1)

La variabile PathNName conterra' directory e nome file da aprire; il path e il nome del programma Adobe Reader lo devi rilevare sul tuo Pc.

Per la descrizione della command line di 7-Zip io ho guardato qui: http://www.dotnetperls.com/7-zip-examples ma una ricerca con la stringa "7zip command line examples" (senza apici) ti dara' innumerevoli altri siti.

Sono spunti che devi integrare nella macro che gestisce il tuo processo, che io non ho ben compreso.
Visto quello che hai fatto non mi sembri un novellino e non dovresti aver difficolta' a implementare quanto detto; ma se hai problemi siamo qui.

Ciao

[zanatta77]

Ciao e grazie per avermi risposto.
Ti spiego meglio il mio problemino da risolvere, praticamente fino ad oggi la macro che avevo creato andava benissimo
perchè cercavo il file per il collegamento ipertestuale su un server, ma adesso ho bisogno di masterizzare tutti i file che mi occorono per il collegamento ipertestuale su un CD dati con cartella.rar protetta da chiave.
Quindi quello che mi occorre è semplicemente modificare la ricerca del collegamento ipertestuale che non deve essere + questo """Foglio1.Hyperlinks.Add anchor:=Range("G2"), Address:="\\Serverther\ARCHIVIO CARICHI ANNO 2011\CONTENITORE CARICHI 2011/1 CM di crico.pdf""""
Ma dovrei modificare lo script in modo che vada a cercare il collegamento ipertestuale all'interno di un CD dove si trova una cartella.rar con chiave.
Il mio problema è scrivere lo script in modo che vada a cercare il file.pdf inserendo la chiave in automatico in modo che possa aprirsi il file per visualizzarlo esattamente come ho fatto fino ad oggi, in questo modo se non si possiede il foglio di excel dove ci sarà registrata la macro che sto cercando di fare con il vostro aiuto sarà impossibile (almeno per curiosi con conoscenze minime....) visualizzare i file.
In modo da limitare al curioso di turno la visualizzazione diretta dei file sul CD, in quanto protetto da chiave.
Spero che adesso sia più chiaro il mio intento
Grazie

[Anthony47]

Anche con quanto hai aggiunto le modalita' che ho suggerito sono valide:
-estrai all' apertura del file excel i file dal cd e li metti in una directory nota usando il codice che ti ho suggerito
-il tuo hyperlink non puntera' piu' a un server ma al tuo pc, in particolare alla directory nota e al file noto
-quando chiudi il file excel cancelli i file presenti nella directory nota.

Ciao

[zanatta77]

Ciao
Diciamo che è quello che cercavo di realizzare, adesso rimane solo un problemino da risolvere.
Quando apro il WorkBook si estrae da solo il file e la chiave si inserisce in automatico ma poi q uando chiudo il WorkBook
il file estratto non scompare rimane li, a me occorre che scompaia.
A me occorre che compaia all'pertura e scompaia alla chiusura del Workbook.
Se mi puoi indicare la modifica da fare grazie !!

Codice: Seleziona tutto

Private Sub Workbook_Open()

     Dim WinRarPath As String 'WinRar.exe location
     Dim RarIt As String 'Command line instruction
     Dim SourceDir As String 'The source directory
     Dim SourceRarFile As String 'The source file
     Dim Source As String 'The combined Rar from path(s)(FROM)
     Dim Dest As String 'The combined unRar to path (TO)
     WinRarPath = "C:\Programmi\WinRar\"
     If Dir(WinRarPath, vbDirectory) = "" Then
         MsgBox "WinRar is not installed in the default directory." _
         & Chr$(13) & "Archiving of files will not be possible."
         Exit Sub
     End If
     Start = Timer
     SourceDir = "C:\Gioco"
     SourceRarFile = "Talo.Rar"
     Source = SourceDir & "\" & SourceRarFile
     If InStr(1, Source, " ", vbTextCompare) <> 0 Then Source = Chr(34) & Source & Chr(34)
     Dest = "C:\Gioco\"
     If Dir(Dest, vbDirectory) = "" Then MkDir Dest
     If InStr(1, Dest, " ", vbTextCompare) <> 0 Then Dest = Chr(34) & Dest & Chr(34)
     '
     RarIt = Shell _
     (WinRarPath & "Rar.exe e -pmajor" & TuaPassword & " " & Source & " " & Dest)
Do
    DoEvents
    If Timer > myStart + 1 Or Timer < myStart Then Exit Do
Loop
End Sub

[Anthony47]

Devi per questo inserire una macro di Workbook_BeforeClose, da inserire nello stesso modulo dove hai la Workbook_Open, ed eseguire il "kill" del /dei file da cancellare.
Qualcosa come

Codice: Seleziona tutto

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Kill "C:\Gioco\*.pdf"   '<<< Cancella tutti i file PDF presenti in quella directory
End Sub


E' un esempio, devi adattare percoro e nome file al tuo caso.

Ciao

[zanatta77]

L' adattamento è andato a buon fne tutta la MACRO compie quanto richiesto.
Unico problema al momento delle verifiche fatte aprendo il file contenente la "macro" su diversi PC e inserendo il CD dati all'interno del lettore, è il seguente su tutti i pc testanti.
Nel momento in cui apro il file excel, parte l'estrazione dei file .Pdf (nel mio caso circa 400)con tanto di finestra Prompt di comandi che indica la percentuale del processo di estrazione, ma se vado a chiudere il file di excel prima della fine del processo di estrazione (100%) quest'ultimo continua fino a raggiungere la totale estrazione ma i file pdf estratti in questo caso non vengono cancellati dalla loro destinazione, questo vanifica tutto il percorso fatto tramite MACRO per far in modo da non rendere facilmente accessibili i file .Pdf se non con il file excel con all'interno la macro fatta.
Quindi chiedo se c'è una soluzione al problema oppure bisogna riscrivere una MACRO che lavori diversamente ma sempre con lo stesso fine.

[Flash30005]

In un modulo dichiari Public
una variabile es. MyMacro
così

Codice: Seleziona tutto

Public MyMacro

Poi all'inzio della tua macro
inserisci

Codice: Seleziona tutto

MyMacro = 1

prima dell'End Sub della macro
inserisci

Codice: Seleziona tutto

MyMacro = 0

In thisworkbook aggiungi al codice esistente

Codice: Seleziona tutto

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MyMacro = 1 Then
Cancel = True
Else
Kill "C:\Gioco\*.pdf"   '<<< Cancella tutti i file PDF presenti in quella directory
End If
End Sub


In questa maniera non sarà possibile chiudere il file (xls) se la macro non è terminata
una volta terminata verranno cancellati i file e si chiuderà il file di excel

ciao

[Anthony47]

Non credo che il metodo proposto da Flash funzioni, perche' intercetta il completamento della macro, non il competamento dei sui effetti.
Come detto il comando Shell e' asincrono rispetto all' esecuzione della macro; per tamponare questa situazione la mia macro prevedeva 10 secondi di "coda" prima di dichiarare concluso il processo, con l' ovvia avvertenza che " Ci sarebbero modi piu' eleganti per determinare se l' estrazione e' finita".
Comunque, nella mia macro (che usava la command line del 7-Zip) questa istruzione restituisce il "PID" number dell' ambiente Dos in cui si esegue il programma di dezip:

Codice: Seleziona tutto

Respp = Shell(myZipProg & " e " & myZipFile & " -o" & myExtrDir & " -p" & myZipPassw, 1)


Definisci Public quella variabile e poi usala per killare quel processo nella Workbook_BeforeClose, che quindi diventerebbe:

Codice: Seleziona tutto

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Resp2 = Shell("taskkill /PID " & Respp & " /F")
'Attendi 2 sec per il completamento del taskkill
myStart = Timer      '<**>
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop
Kill "C:\Gioco\*.pdf"   '<<< Cancella tutti i file PDF presenti in quella directory
End Sub

Per dichiarare Public la variabile, metti in Testa al Modulo che contiene la macro:

Codice: Seleziona tutto

Public Respp As Long


Nella tua macro che usa WinRar, il lavoro lo farai su RarIt che eliminerai dalle Dim in testa alla macro per dichiararla Public.

Ciao, fai sapere.

Nota<**>: riga mancante per errore nella prima formulazione del mio messaggio
Anthony

[zanatta77]

Ciao e grazie per avermi nuovamente risposto e illuminato, ma non vorrei sbagliare la formazione dello script quindi cortesemente vi chiedo di modificare questo che vi inserisco in modo da non avere Debug ecc ecc, ovviamente sempre se possibile Grazie !!!
In ThisWorkbook questo è l'attuale script

Codice: Seleziona tutto

     Private Sub Workbook_Open()     
     Dim WinRarPath As String 'WinRar.exe location
     Dim RarIt As String 'Command line instruction
     Dim SourceDir As String 'The source directory
     Dim SourceRarFile As String 'The source file
     Dim Source As String 'The combined Rar from path(s)(FROM)
     Dim Dest As String 'The combined unRar to path (TO)
     WinRarPath = "C:\Programmi\WinRar\"
     If Dir(WinRarPath, vbDirectory) = "" Then
         MsgBox "WinRar is not installed in the default directory." _
         & Chr$(13) & "Archiving of files will not be possible."
         Exit Sub
     End If
     SourceDir = "D:"
     SourceRarFile = "ARCHIVIO CARICHI e SCARICHI CM 1-2-3 ANNO 2011.Rar"
     Source = SourceDir & "\" & SourceRarFile
     If InStr(1, Source, " ", vbTextCompare) <> 0 Then Source = Chr(34) & Source & Chr(34)
     Dest = "C:\Servito"
     If Dir(Dest, vbDirectory) = "" Then MkDir Dest
     If InStr(1, Dest, " ", vbTextCompare) <> 0 Then Dest = Chr(34) & Dest & Chr(34)
     RarIt = Shell _
     (WinRarPath & "Rar.exe e -pmarilena" & TuaPassword & " " & Source & " " & Dest)
     Start = Timer
Do
    DoEvents
    If Timer > myStart + 10 Or Timer < myStart Then Exit Do
Loop
End Sub

Nel foglio1 invece è presente questo script:

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Cellss(5, 3) = "carico1" Then
    Range("G2") = "Documento visionabile"
    Foglio1.Hyperlinks.Add Anchor:=Range("G2"), Address:="C:/Servito/1 CM 1 2 3 di carico.pdf"
ElseIf Cells(5, 3) = "carico22" Then
    Range("G2") = "Documento visionabile"
    Foglio1.Hyperlinks.Add Anchor:=Range("G2"), Address:="C:/Servito/22 CM 1 2 3 di carico.pdf"
ElseIf Cells(5, 3) = "carico222" Then
    Range("G2") = "Documento visionabile"
    Foglio1.Hyperlinks.Add Anchor:=Range("G2"), Address:="C:/Servito/222 CM 1 2 3 di carico.pdf"
Else
    Hyperlinks.Delete
    Range("G2") = "DOCUMENTO NON ELABORATO"
End If
End Sub

Nel Foglio2 è presente:

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Cells(25, 3) = "scarico1" Then
    Range("G16") = "Documento visionabile"
    Foglio1.Hyperlinks.Add Anchor:=Range("G16"), Address:="C:/Servito/1 CM 1 2 3 di scarico.pdf"
ElseIf Cells(25, 3) = "scarico2" Then
    Range("G16") = "Documento visionabile"
    Foglio1.Hyperlinks.Add Anchor:=Range("G16"), Address:="C:/Servito/2 CM 1 2 3 di scarico.pdf"
ElseIf Cells(25, 3) = "scarico3" Then
    Range("G16") = "Documento visionabile"
    Foglio1.Hyperlinks.Add Anchor:=Range("G16"), Address:="C:/Servito/3 CM 1 2 3 di scarico.pdf"
Else
    Foglio2.Hyperlinks.Delete
    Range("G16") = "DOCUMENTO NON ELABORATO"
End If
End Sub

[Anthony47]

Non credo che ci siano particolari difficolta' nell' applicare il suggerimento; prova e se succede qualcosa siamo qua.

Ciao

[zanatta77]

Provo a scrivere lo script
Cortesemente controllate se va bene
Grazie

Il seguente script per riepilogare si trova su ThisWorkbook in (generale) (dichiarazioni)

Codice: Seleziona tutto

      Private Sub Workbook_Open()     
     Dim WinRarPath As String 'WinRar.exe location
     Dim RarIt As String 'Command line instruction
     Dim SourceDir As String 'The source directory
     Dim SourceRarFile As String 'The source file
     Dim Source As String 'The combined Rar from path(s)(FROM)
     Dim Dest As String 'The combined unRar to path (TO)
     WinRarPath = "C:\Programmi\WinRar\"
     If Dir(WinRarPath, vbDirectory) = "" Then
         MsgBox "WinRar is not installed in the default directory." _
         & Chr$(13) & "Archiving of files will not be possible."
         Exit Sub
     End If
     SourceDir = "D:"
     SourceRarFile = "ARCHIVIO CARICHI e SCARICHI CM 1-2-3 ANNO 2011.Rar"
     Source = SourceDir & "\" & SourceRarFile
     If InStr(1, Source, " ", vbTextCompare) <> 0 Then Source = Chr(34) & Source & Chr(34)
     Dest = "C:\Servito"
     If Dir(Dest, vbDirectory) = "" Then MkDir Dest
     If InStr(1, Dest, " ", vbTextCompare) <> 0 Then Dest = Chr(34) & Dest & Chr(34)
     RarIt = Shell _
     (WinRarPath & "Rar.exe e -pmarilena" & TuaPassword & " " & Source & " " & Dest)
     Start = Timer
Do
    DoEvents
    If Timer > myStart + 10 Or Timer < myStart Then Exit Do
Loop
End Sub
________________________________________________________________________________________________________________
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Resp2 = Shell("taskkill /PID " & Respp & " /F")
'Attendi 2 sec per il completamento del taskkill
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop
Kill "C:\Servito\*.pdf"   '<<< Cancella tutti i file PDF presenti in quella directory
End Sub
 

[zanatta77]

Prima di venerdi 14 non posso testarlo quindi per il momento grazie.

[Anthony47]

Riguardando la tua macro mi sono accorto che, per attendere un tot di secondi, ho suggerito di usare questo codice (es con attesa 2 sec):

Do
DoEvents
If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop

Questo E' ERRATO, anzi e' monco; infatti subito prima di "Do" va compilata la variabile myStart con il contenuto del timer, altrimenti la macro non attende un bel niente, visto che al primo confronto risultera' subito "Timer > myStart + 2 = True" terminando cosi' immediatamente l' attesa.
Il codice completo quindi e':

Codice: Seleziona tutto

myStart = Timer
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop


(sempre esempio per 2 sec)

Pertanto ho aggiornato il tuo codice inserendo questa mia correzione; inoltre ho modificato i messaggi precedenti per eliminare l' errore.
In futuro usero' la versione "Function" del codice, teoricamente dovrebbe ridurre il rischio di distrazioni e potrebbe anche semplificare il codice in caso di attese multiple.

Come ulteriore modifica alla tua macro ho inserito la dichiarazione che ti avevo detto di inserire, eliminando la Dim che ti avevo detto di eliminare.
(nota: ho modificato la visibilita' di Respp da Public a Private per evitare confusione; infatti anche se dichiarata Public la validita' sarebbe stata limitata al modulo di codice ThisWorkbook. L' alternativa sarebbe dichiarare la variabile Public in un Modulo di codice standard, es Modulo1)

Il codice modificato, da inserire in ThisWorkbook:

Codice: Seleziona tutto

Private RarIt as Long                 '** Rigorosamente in testa al modulo

         Private Sub Workbook_Open()     
         Dim WinRarPath As String 'WinRar.exe location
         'Dim RarIt As String 'Command line instruction           '**
         Dim SourceDir As String 'The source directory
         Dim SourceRarFile As String 'The source file
         Dim Source As String 'The combined Rar from path(s)(FROM)
         Dim Dest As String 'The combined unRar to path (TO)
         WinRarPath = "C:\Programmi\WinRar\"
         If Dir(WinRarPath, vbDirectory) = "" Then
             MsgBox "WinRar is not installed in the default directory." _
             & Chr$(13) & "Archiving of files will not be possible."
             Exit Sub
         End If
         SourceDir = "D:"
         SourceRarFile = "ARCHIVIO CARICHI e SCARICHI CM 1-2-3 ANNO 2011.Rar"
         Source = SourceDir & "\" & SourceRarFile
         If InStr(1, Source, " ", vbTextCompare) <> 0 Then Source = Chr(34) & Source & Chr(34)
         Dest = "C:\Servito"
         If Dir(Dest, vbDirectory) = "" Then MkDir Dest
         If InStr(1, Dest, " ", vbTextCompare) <> 0 Then Dest = Chr(34) & Dest & Chr(34)
         RarIt = Shell _
         (WinRarPath & "Rar.exe e -pmarilena" & TuaPassword & " " & Source & " " & Dest)
         Start = Timer
    myStart = Timer              '**
    Do
        DoEvents
        If Timer > myStart + 10 Or Timer < myStart Then Exit Do
    Loop
    End Sub
   

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Resp2 = Shell("taskkill /PID " & RarIt & " /F")          '**
    'Attendi 2 sec per il completamento del taskkill
    MyStart = Timer                '**
    Do
        DoEvents
        If Timer > myStart + 2 Or Timer < myStart Then Exit Do
    Loop
    Kill "C:\Servito\*.pdf"   '<<< Cancella tutti i file PDF presenti in quella directory
    End Sub


Le modifiche (aggiunte o variazioni) sono marcate **

Quando puoi fai il collaudo.

Fai sapere...

Ciao

[zanatta77]

Per la serie la curiosità non è solo DONNA....oggi pomeriggio sono riuscito durante il riposo dei bimbi a fare delle prove cambiando i percorsi dei file e tutto questo per non aspettare il venerdì.
La macro compie quanto richiesto compresa l'ultima modifica (aspetta che i file .Pdf siano tutti estratti poi permetti chiusura excel) infatti per essere certo che aspettasse l'estrazione prima di chiudere excel ho messo ben 800 file .Pdf nella cartella.Rar.
Che dire ragazzi grazie mille soprattutto a te Anthony per la tua disponibilità,generosita e professionalita, la mia richiesta possiamo dichiararla realizzata.
Adesso cercherò di implementare questa macro con un file audio .Wav (come sottofondo musicale) che vada in Play a inizio ricerca e termini a chiusura del file excel.

[zanatta77]

Vorrei adattare questo script in modo da farlo andare in Play all'apertura del WorkBook e in Stop alla chiusura con Messaggio incluso.
Il brano da eseguire .Wav vorrei metterlo all'intero del CD dati insieme alla cartella da estrarre.

Come devo impostarlo e dove inserire gli script ??? Sicuramente devo fare un nuovo modulo e metterci la Public Declare, ma il restante dello script come si modifica e dove lo scrivo ??
Grazie.

Codice: Seleziona tutto

Public Declare Function sndPlaySound Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long


Sub PlayWavFile(WavFileName As String, Wait As Boolean)
    If Dir(WavFileName) = "" Then Exit Sub    ' nessun file da riprodurre, esce
    If Wait Then      ' sincrono: riproduce il suono per intero prima di continuare
        sndPlaySound WavFileName, 0
    Else    ' asincrono: riproduce il suono indipendentemente dall'esecuzione del resto del codice
        sndPlaySound WavFileName, 1
    End If
End Sub


Sub TestPlay()
    PlayWavFile "D:\Tensione_Evolutiva.wav", False
    MsgBox "Ricerca dei documenti in atto..."
    PlayWavFile "D:\Tensione_Evolutiva.wav", True
    MsgBox "Riceca documenti completata ..."
End Sub

[Anthony47]

I miei "gadget natalizi" includono sempre un accompagnamento musicale; ad esempio guarda viewtopic.php?f=26&t=93899
Vedi anche viewtopic.php?f=26&t=76725#p435762 col link all' articolo Microsoft che spiega l' uso della sndPlaySoundA

Vedi se tra quanto disponibile trovi da solo lo spunto giusto.

Vorrei inoltre ricordarti, prima che passi alla distribuzione di quanto sviluppato, che non e' detto che il drive CD sia rappresentato da "D:"; ad esempio sul mio Pc corrisponde al drive "E:"

Infine una precisazione, rispetto a quanto scrivi qui: viewtopic.php?f=26&t=97764&p=561978#p561956
Con quanto da me suggerito non si aspetta di aver estratto tutti i file, ma si termina il processo di importazione prima di procedere alla cancellazione dei file estratti, garantendo quindi che la directory di estrazione alla fine sia vuota.

Ciao

[zanatta77]

Ho provato questo metodo d'incorporazione file audio come oggetto per apertura workbook, funziona ma apre la finestra di WindowsMediaPlayer che volendo si può stoppare la riproduzione, mentre invece con quello proposto da me lo fa direttamente dalla libreria di Windows che gestisce il multimedia per suonare un file WAV. Vorrei modificare lo script inserito da me per farlo andare in play a WorkBook_Open e che vada in stop con WorkBook_Close con tanto di messaggio incluso ma per ora non riesco vediamo se qualcuno mi aiuta

Codice: Seleziona tutto

Private Sub Workbook_Open()
ActiveSheet.Shapes("Object 18").Select
Selection.Verb Verb:=xlPrimary
End Sub


[Anthony47]

Metti l' istruzione PlayWavFile "D:\Tensione_Evolutiva.wav", False nella tua WorkbookOpen, subito dopo la riga SourceDir = "D:"
Poi la riga PlayWavFile "D:\Tensione_Evolutiva.wav", True eventualmente insieme con MsgBox "Ricerca documenti completata ..." subito prima della End Sub.

Il primo MsgBox non puo' essere un MsgBox; se vuoi qualcosa di confrontabile devi usare una UserForm che contenga solo quel testo; poi per visualizzarla userai UserForm1.Show vbModeless subito prima della prima PlayWavFile, seguita da Unload UserForm1 da mettere prima del msgbox finale

Metti la Public Declare e la Sub PlayWavFile su un Modulo standard di codice, es Modulo1 (la Public Declare deve rimanere in testa al modulo)

Prova, se non riesci a chiudere fatti sentire dicendo dove sei arrivato e su che cosa ti sei incagliato...

Ciao

[zanatta77]

Ciao
Faccio prima a inviare l'immagine di quello che ho fatto e dove inseriti, purtroppo non funziona e appena apro mi esce un messaggio di errore run 52 più la form come finestra di colore grigio.
Non fare caso al percorso cambiato C: ecc ecc in quanto sto facendo delle prove a casa e non avendo il cd dati dietro devo forzatamente cambiare.
Rimango in attesa di sapere qualcosa in merito
Grazie.