Numero progressivo assegnato ad un file .7z tramite macro... è possibile?

Question

Buongiorno,

Uso gia un comando da riga dos, in un file .bat, per eseguire una copia da una cartella windows verso un altra.

Le istruzioni nel file .bat sono:

@echo off

rem devo trasferire da pdbdocumenti a backup

@echo.

rem qui imposto la data

%date:~-4%-%date:~3,2%-%date:~0,2%

rem qui imposto il nome del file

SET NomeFile1=Backup_%date:~-4%-%date:~3,2%-%date:~0,2%.7z

@echo.

rem qui avvio compressione e spostamento del file

cd C:\Program Files\7-Zip

7z a -V100M -Ppassword C:\Users\Alfredo\Backup%NomeFile1% %NomeFile1% C:\Users\Alfredo\PdbDocumenti\archivio

@echo.

Quindi: Eseguo il file . bat (contenente le istruzioni di cui sopra) cliccando il CommandButton1 in una user e ottengo il file copia zippato con nome data e ora.

Ottengo un file con nome tipo: "Backup_2016-04-22__12_28_41.7z"

Avendo l'esigenza di assegnare un numero progressivo a queste copie, numero che già genero in un foglio di excel (es.: Foglio1 cella A1) vorrei ottenere un file con nome tipo: "004_2016-04-22__12_28_41.7z" dove "004" è il valore contenuto nella cella A1 de Foglio1

Vorrei sapere se si puo, con una macro, istruire la funzione che lancia il file .bat aggiungendo al nome file zippato il numero progressivo preso dalla cella A1 del Foglio1, e se si come?

Andrebbe bene anche eseguire (se mai fosse possibile) tutte le istruzioni, comprese quelle che gia eseguo in dos, con una macro.

Il codice nella macro che uso per lanciare il file .bat è:

Private Sub Copia()

' Lanciato da CommandButton1

    Dim Val

Val = Shell("C:\Windows\Funzioni\Copie.bat", vbMinimizedFocus)

End Sub

Grazie per l'interessamento

Alfredo

Answer 1

Ciao Alfredo,

Ammetto il mio limite... non è che abbia capito tanto, ma, provando questo "eccellente" lavoro prodotto da Norman David Jones, sono rimasto veramente soddisfatto.

Bene!

Unica pecca, e non so come porre rimedio, è:

Se nella cartella "C:\Users\Alfredo\Odrive\PdbDocumenti\Archivio" ci sono delle sottocartelle, queste non vengono copiate e neanche i files al loro interno.

Sono certo che il problema nasce dal fatto che io non abbia specificato che nella cartella ci fossero files e cartelle contenenti files.

Io avevo risposto alla domanda fatta da te. Per zippare anche i file che si trovano in ogni sottocartella,  ad infinitum, prova invece il codice al di sotto.

Apparte questo và alla grande, la copia avviene, il trasferimento della copia avviene e durante l'esecuzione della copia non si puo fare altre funzioni!

Vedi i miei comment dopo al di sotto del seguente codice.

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'==========>>

Option Explicit

Public iCtr As Long

'--------->>

Public Sub Tester()

    iCtr = 0

    Application.StatusBar = "Per piacere sii paziente:un backup è in corso!"

    Call SelectFiles

    Application.StatusBar = False

End Sub

'--------->>

Public Sub SelectFiles(Optional sPath As String)

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range

    Dim sStr As String

    Dim sFilename

    Const srcFolder As String = _

          "**C:\Users\Alfredo\Odrive\PdbDocumenti\Archivio**"

    Const sDestFolder As String = _

          "**C:\Users\Alfredo\Odrive\Backup**'

    Const sFoglio As String = "Foglio1"

    Const sCella As String = "A1"

    Const sEst As String = ".zip"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    Set Rng = SH.Range(sCella)

    sStr = Format(Rng.Value, "000") & "_" & Format(Date, "dd_mm_yyyy") & sEst

    sFilename = sDestFolder & sStr

    Call ZipFile(sFilename)

    Call ProcessFiles(srcFolder, sFilename)

    With Rng

        .Value = .Value + 1

    End With

    WB.Save

    Call MsgBox(Prompt:="I file di backup è stato salvato sotto il nome: " _

                      & sFilename _

                      & vbNewLine _

                      & "Il nuovo numero progressivo e' " _

                      & Format(Rng.Value, "000"), _

                Buttons:=vbInformation, _

                Title:="Report")

End Sub

'--------->>

Public Sub ProcessFiles(sPath As String, sFilename)

    Static oFSO As Object

    Static oApp As Object

    Dim oFolder As Object

    Dim oSubFolder As Object

    Dim oFile As Object

    If oApp Is Nothing Then

        Set oApp = CreateObject("Shell.Application")

    End If

    If oFSO Is Nothing Then

        Set oFSO = CreateObject("SCripting.FileSystemObject")

    End If

    Set oFolder = oFSO.GetFolder(sPath)

    For Each oFile In oFolder.Files

    Application.StatusBar = "Elaborando il file: " & oFile.Path

        iCtr = iCtr + 1

        oApp.Namespace(sFilename).CopyHere oFile.Path

        On Error Resume Next

        Do Until oApp.Namespace(sFilename).items.Count = iCtr

            Application.Wait (Now + TimeValue("0:00:01"))

        Loop

        On Error GoTo 0

    Next oFile

     For Each oSubFolder In oFolder.SubFolders

        Call ProcessFiles(oSubFolder.Path, sFilename)

    Next

End Sub

'--------->>

Public Sub ZipFile(sPath)

    If Len(Dir(sPath)) > 0 Then Kill sPath

    Open sPath For Output As #1

    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)

    Close #1

End Sub

'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester | Esegui

Nota che con questa codice l'elaborazione di ciacun file viene riportata sequenzialmente sulllla barra di stato (Status Bar) al fondo della finestra Excel.

P.S.: Approfitto... mica è possibile chiudere, sempre tramite vba, le finestre di windows?

Consulto spesso l'archivio e mi restano tipo 30 finestre aperte.

uso questo comando x aprire

Private Sub ApriArchivio()
'Apre Cartella PC
    WinExec "Explorer.exe C:\Users\Alfredo\Odrive\PdbDocumenti\Archivio", 10
End Sub

Per anche aiutare altri con un problema simile, credo sia meglio aprire un nuovo thread per questa domanda distinta.

===

Regards,

Norman

Answer 2

Ciao Alfredo,

Avevo trascurato la rinominazione del file! Pertanto, sostituisci il codice precedente con qualcosa del genere:

'==========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range

    Dim FSO As Object

    Dim oFile As Object

    Dim sFname As Variant

    Dim sStr As String

    Dim oldFolder As String

    Const srcFolder As String = "C:\Users\Alfredo\Odrive\Backup"

    Const sDestFolder As String ="C:\Users\Alfredo\Odrive\PdbDocumenti\Archivio"

    Const sFoglio As String = "Sheet1"

    Const sEst As String = ".xlsx"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    Set Rng = SH.Range("A1")

    sStr = Rng.Value & Format(Date, "dd-mm-yy") & sEst

    oldFolder = CurDir

    ChDir srcFolder

    Set FSO = CreateObject("Scripting.FileSystemObject")

    sFname = Application.GetOpenFilename( _

             FileFilter:="Excel Workbooks,*.xls*", _

             Title:="Open a File", _

             MultiSelect:=False)

    If sFname <> "False" Then

        FSO.getfile(sFname).Copy (sDestFolder & sStr)

    End If

XIT:

    ChDir oldFolder

End Sub

'<<=========

===

Regards,

Norman

Answer 3

Grazie per l'interesse, sto facendo un po di prove, x il momento penso di poterla adattare.

Questa routine mi permette di prendere un solo file e trasportarlo in altra dir, non ho ancora compreso come posso fargli zippare tutta una directory con tutto il contenuto e trasportare solo il file compresso in un altra dir.

Ma non mi arrendo....

Grazie Alfredo

Answer 4

Ciao Alfredo,

Ho risolto in maniera moooolto artigianale, e posto la soluzione per chi avesse lo stesso problema ed anche per chi avesse una idea migliore o una forma piu elegante.

Private Sub DadosAvba()

 

  'da qui ottengo il numero progressivo e la data e .7z

    fname = Sheets(1).Range("A1") & "_" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".7z"

   'da qui fondo il nome file con l'istruzione dos

     comando = ("C:\Program Files\7-Zip\7z a -V100M -Pchecazzo C:\Users\Alfredo\Odrive\Backup""" & fname & """ """ & "C:\Users\Alfredo\Odrive\PdbDocumenti\Archivio")

'da qui lo invio a Shell per esecuzione

      Shell comando

  'dopo la copia aggiorno il progressivo

       Application.Run "AggiornaProgressivo"

End Sub

Funziona ma la macro va avanti senza aspettare la fine della copia e proprio non so come fare x aspettare che la shell finisca prima di continuare!

Magari qualcuno mi da una dritta!

Buona serata a tutti e grazie!!!

Alfredo

Io so ben poco di 7Zip, Però, per il tuo scopo vorrei convertire la cartella di destinazione Archivio in una cartella compressa,in modo che tutti i file che vengano copiati in questa cartella siano comprime automaticamente da Windows, e utilizzerei una routine del seguente tipo:

'==========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim FSO As Object

    Dim oFile As Object

    Dim sFname As Variant

    Dim oldFolder As String

    Const srcFolder As String = "**C:\Users\Alfredo\Odrive\Backup**"

    Const sDestFolder As String = "**C:\Users\Alfredo\Odrive\PdbDocumenti\Archivio**"

     oldFolder = CurDir

    ChDir srcFolder

    Set FSO = CreateObject("Scripting.FileSystemObject")

    sFname = Application.GetOpenFilename( _

             FileFilter:="Excel Workbooks,*.xls*", _

             Title:="Open a File", _

             MultiSelect:=False)

    If sFname <> "False" Then

        FSO.CopyFile sFname, sDestFolder

    End If

XIT:

    ChDir oldFolder

End Sub

'<<=========

===

Regards,

Norman

Answer 5

Ho risolto in maniera moooolto artigianale, e posto la soluzione per chi avesse lo stesso problema ed anche per chi avesse una idea migliore o una forma piu elegante.

Private Sub DadosAvba()

  'da qui ottengo il numero progressivo e la data e .7z

    fname = Sheets(1).Range("A1") & "_" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".7z"

   'da qui fondo il nome file con l'istruzione dos

     comando = ("C:\Program Files\7-Zip\7z a -V100M -Pchecazzo C:\Users\Alfredo\Odrive\Backup""" & fname & """ """ & "C:\Users\Alfredo\Odrive\PdbDocumenti\Archivio")

'da qui lo invio a Shell per esecuzione

      Shell comando

  'dopo la copia aggiorno il progressivo

       Application.Run "AggiornaProgressivo"

End Sub

Funziona ma la macro va avanti senza aspettare la fine della copia e proprio non so come fare x aspettare che la shell finisca prima di continuare!

Magari qualcuno mi da una dritta!

Buona serata a tutti e grazie!!!

Alfredo