Option Explicit
Public intRisCD As Integer
'---------------------------------------------------------------
Private Sub Form_Load()
ProgressBar1.min = 0
ProgressBar1.max = 100
End Sub
'---------------------------------------------------------------
Private Sub Command1_Click()
'Legge percorso e Nome della cartella principale:
Set dSorg = FSO.GetFolder(App.Path & "\DATI")
'Evidenzia l'Origine della copia:
Frm1.LblOrigine2.Caption = dSorg
'Legge capacità in bytes della cartella principale:
btFolder = dSorg.Size
If btFolder > 0 Then
Frm1.MousePointer = 11
Call ClearInfo
'Informa sul totale dei bytes da copiare:
TxtDcopy.Text = Format(btFolder, "#,##0")
'Chiama le routine:
Call CopySubFoldersX
Call CopyFilesX
Frm1.MousePointer = 0
End If
End Sub
'---------------------------------------------------------------
'Pulisce le variabili ed i controlli:
Private Sub ClearInfo()
If Frm1.ProgressBar1.value <> 0 Then
Frm1.ProgressBar1.value = 0
Frm1.lblInfo.Caption = ""
Frm1.TxtDcopy.Text = ""
Frm1.TxtCopiati.Text = ""
Frm1.TxtPerc.Text = ""
bytesScritti = 0
fileLenght = 0
End If
End Sub
'---------------------------------------------------------------
'Chiusura della Frm con Exit o X:
Private Sub Form_QueryUnload(Cancel As Integer, unloadMode As Integer)
Select Case unloadMode
Case vbFormControlMenu
'il form è chiuso dall'utente:
Call CmdExit_Click
End Select
'Non esce dall'applicazione:
If intRisCD = vbNo Then
Cancel = 1
End If
End Sub
'---------------------------------------------------------------
Private Sub CmdExit_Click()
intRisCD = MsgBox("Chiudere l'applicazione ?", vbYesNo + vbQuestion, "Applicazioni Aziendali")
If intRisCD = vbYes Then
Set FSO = Nothing
Unload Frm1
Set Frm1 = Nothing
End If
If intRisCD = vbNo Then
Exit Sub
End If
End Sub
' Codice da inserire in un modulo Bas:
Option Explicit
Public btFolder As Long
Public fileLenght As Long
Public bytesScritti As Long
Public DestCopy As String
Dim vrnF1 As Variant
Dim vrnSF As Variant
'---------------------------------------------------------------
Public Sub CopySubFoldersX()
'Destinazione della copia:
DestCopy = "D:\Elaborazioni\VBEsempi\ProgressBSFeFil\DATI2"
'Evidenzia la Destinazione della copia:
Frm1.LblDest.Caption = DestCopy
'Istanzia la subFolder:
Set vrnSF = dSorg.SubFolders
For Each vrnF1 In vrnSF
'Acquisisce lunghezza della SubFolder:
fileLenght = vrnF1.Size
'Da modificare con il percorso di destinazione - copia le SubFolder:
FSO.CopyFolder vrnF1, DestCopy, True
'Evidenzia la SubFolder copiata:
Frm1.lblInfo.Caption = vrnF1
Frm1.lblInfo.Refresh
Frm1.ProgressBar1.value = Percent(0, btFolder, bytesScritti + fileLenght)
bytesScritti = bytesScritti + fileLenght
'Evidenzia i bytes copiati:
Frm1.TxtCopiati.Text = Format(bytesScritti, "#,##0")
Frm1.TxtPerc.Text = Format((bytesScritti / btFolder) * 100, "#,##0.00")
Frm1.ProgressBar1.Refresh
Next vrnF1
End Sub
'---------------------------------------------------------------
Function Percent(min As Long, max As Long, value As Long) As Long
'100 : x = btFolder : bytesScritti
Percent = value * 100 \ max
End Function
'---------------------------------------------------------------
Public Sub CopyFilesX()
Dim KbFolder As Long
Dim strPercOrig As String
For Each f In dSorg.
Files 'Acquisisce lunghezza del File:
fileLenght = f.Size
'Acquisisce il percorso di origine del File:
strPercOrig = f.ParentFolder
'Da modificare con il percorso di destinazione - copia i Files:
FSO.CopyFolder strPercOrig, DestCopy, True
KbFolder = dSorg.Size
'Evidenzia il file copiato:
Frm1.lblInfo.Caption = f
Frm1.lblInfo.Refresh
Frm1.ProgressBar1.value = Percent2(0, KbFolder, bytesScritti + fileLenght)
bytesScritti = bytesScritti + fileLenght
'Evidenzia i bytes copiati:
Frm1.TxtCopiati.Text = Format(bytesScritti, "#,##0")
'Evidenzia la % di progressione:
Frm1.TxtPerc.Text = Format((bytesScritti / KbFolder) * 100, "#,##0.00")
'Aggiorna la ProgressBar:
Frm1.ProgressBar1.Refresh
Next f
End Sub
'---------------------------------------------------------------
Function Percent2(min As Long, max As Long, value As Long) As Long
Percent2 = value * 100 \ max
End Function
