Newsgroup: it.comp.appl.access
Titolo: Cerco un'ape, un ActiveX, un tool, un plug-in, qualunque cosa (rif. mio precedente post "Back-up archivi pilotato da Access. Problemi")

Mi rifaccio al mio precedente post "Back-up archivi pilotato da Access. 
Problemi."
Non ho ricevuto risposte significative. Forse il quesito era posto male o in 
modo troppo prolisso.
Però ho urgenza di risolvere il problema. O quantomeno che qualche esperto 
mi dica che il problema non ha soluzione, e quindi di smettere di perdere 
tempo.
Riducendo all'osso mi serve un qualcosa che mi consenta di lanciare la copia 
di una cartella facendo comparire sul monitor la mascherina che compare 
quando si esegue la copia di un file o di una cartella in Esplora Risorse di 
Windows, quella che contiene il fogliettino volante da una cartella 
all'altra, con l'indicazione del nome del file e una valutazione 
approssimata del tempo necessario alla copia, sotto forma di una barretta 
con le tacche di avanzamento e in chiaro i minuti restanti alla fine.
Se non proprio quella, qualcosa di simile, che consenta all'utente di avere 
un'idea della durata della copia in corso.
L'uso del "CopyFolder", che ho adottato io, funziona bene. Fa la copia, ma 
l'utente resta impiccato davanti al monitor senza sapere per quanto 
tempo!... E questo è un problema, specie con copie lunghe (anche mezz'ora) 
da PC utente a Server, tramite rete.
Ringrazio quanti potranno darmi una mano.
lu...@tele2.it
 - Torino

 wrote in message 
news:433ec...@x-privat.org

La funzione sotto fà proprio quello che chiedi ma
sul singolo file, ma se la Folder contiene il BE 
devi assicurarti che non ci siano
aperte connessioni o recordset alle tabelle.
QUESTO METTILO IN UNA FORM CON UN COMMAND BUTTON
Private Const TEMPDIR = "_$$Tmp$$"  'Directory name unlikely to exist
already
Private Declare Function GetSystemDirectory Lib "kernel32" Alias
"GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As
Long
'Demonstrate CSHFileOp class
Private Sub Command1_Click()
    Dim fileop As New CSHFileOp
    Dim sSysDir As String
    'Tell user what we are doing and give them a chance to back out
    If MsgBox("This program will demonstrate the CSHFileOp class by
first " & _
        "copying all the help files from your Windows system directory
to " & _
        "a temporary directory, and then deleting that temporary
directory " & _
        "and all of its contents." & vbCrLf & vbCrLf & "Do you want to "
& _
        "proceed?", vbQuestion Or vbYesNo) <> vbYes Then
        Exit Sub
    End If
    'Make our form the parent window of the
    'SHFileOperation dialog box (optional)
    fileop.ParentWnd = hWnd
    'Get Windows system directory
    sSysDir = String$(512, Chr$(0))
    GetSystemDirectory sSysDir, 512
    sSysDir = Left$(sSysDir, InStr(sSysDir, Chr$(0)) - 1)
    'Ensure trailing backslash
    If Right$(sSysDir, 1) <> "\" Then
        sSysDir = sSysDir & "\"
    End If
    'Copy all the help files in the Windows system directory
    fileop.ClearSourceFiles
    fileop.AddSourceFile sSysDir & "*.hlp"
    'To a temporary subdirectory
    fileop.ClearDestFiles
    fileop.AddDestFile sSysDir & TEMPDIR
    'Copy the files
    If Not fileop.CopyFiles Then
        MsgBox "One or more operations were not successfully completed."
        Exit Sub
    End If
    'Now delete the temporary directory and all contents
    fileop.ClearSourceFiles
    fileop.ClearDestFiles
    fileop.AddSourceFile sSysDir & TEMPDIR
    'Delete the directory
    If Not fileop.DeleteFiles Then
        MsgBox "One or more operations were not successfully completed."
        Exit Sub
    End If
End Sub
'************* MODULO DI CLASSE da chiamare CSHFileOp **************
'SHFileOp - VB program that demonstrates using SHFileOperation
'Copyright (c) 1997 SoftCircuits Programming (R)
'Redistributed by Permission.
'
'Starting with Windows 95, the Windows API provides the SHFileOperation
'function. This function provides many options for copying, moving,
'renaming and deleting files. For lengthy operations, a dialog box is
'displayed that indicates the current operation and progress. This is
'exactly the same progress dialog box displayed by the Windows Explorer
'because the Windows Explorer also calls SHFileOperation.
'
'The CSHFileOp class encapsulates SHFileOperation making it much
'easier to use. Not only does it provide much easier access to the many
'options but performs some special work so that SHFILEOPSTRUCT can be
'fully exploited by VB. Most available options are implemented as class
'properties and methods. For example, set the AllowUndo property to
'True to cause deleted files to be sent to the Recycle Bin. View the
'comments within the source code for information about these options.
'Refer to the Windows API documentation for additional information.
'
'After specifying the source and destination files and setting any
'options you want, call the CopyFiles, MoveFiles, DeleteFiles or
'RenameFiles methods to perform the operation. Each of these methods
'returns True if all operations completely successfully, or False if
'there was an error or the user canceled an operation. (Note: You do
'not normally need to display error information because Windows will
'notify the user of any tasks that could not be completed.)
'
'This program may be distributed on the condition that it is
'distributed in full and unchanged, and that no fee is charged for
'such distribution with the exception of reasonable shipping and media
'charged. In addition, the code in this program may be incorporated
'into your own programs and the resulting programs may be distributed
'without payment of royalties.
'
'This example program was provided by:
' SoftCircuits Programming
' 
http://www.softcircuits.com
' P.O. Box 16262
' Irvine, CA 92623
Option Explicit
'Default property values
Private Const DEFAULT_ALLOWUNDO = False
Private Const DEFAULT_CONFIRMMAKEDIR = True
Private Const DEFAULT_CONFIRMOPERATION = True
Private Const DEFAULT_CUSTOMTEXT = ""
Private Const DEFAULT_INCLUDEDIRECTORIES = True
Private Const DEFAULT_PARENTWND = 0
Private Const DEFAULT_RENAMEONCOLLISION = False
Private Const DEFAULT_SILENTMODE = False
'SHFileOperation declarations
Private Const FO_MOVE = 1
Private Const FO_COPY = 2
Private Const FO_DELETE = 3
Private Const FO_RENAME = 4
Private Const FOF_MULTIDESTFILES = &H1
Private Const FOF_SILENT = &H4
Private Const FOF_RENAMEONCOLLISION = &H8
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_WANTMAPPINGHANDLE = &H20
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_FILESONLY = &H80
Private Const FOF_SIMPLEPROGRESS = &H100
Private Const FOF_NOCONFIRMMKDIR = &H200
Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias
"SHFileOperationA" (lpFileOp As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo
As Any, pFrom As Any, ByVal lCount As Long)
'Private variables
Private m_bAllowUndo As Boolean
Private m_bConfirmMakeDir As Boolean
Private m_bConfirmOperation As Boolean
Private m_sCustomText As String
Private m_bIncludeDirectories As Boolean
Private m_hParentWnd As Long
Private m_bRenameOnCollision As Boolean
Private m_bSilentMode As Boolean
Private m_SourceFiles As New Collection
Private m_DestFiles As New Collection
'=== Public Properties ======================================
'Sets if Windows stores undo information (if possible)
Public Property Let AllowUndo(bAllowUndo As Boolean)
    m_bAllowUndo = bAllowUndo
End Property
'Gets if Windows stores undo information (if possible)
Public Property Get AllowUndo() As Boolean
    AllowUndo = m_bAllowUndo
End Property
'Sets if is user is prompted before creating any needed directories
Public Property Let ConfirmMakeDir(bConfirmMakeDir As Boolean)
    m_bConfirmMakeDir = bConfirmMakeDir
End Property
'Gets if is user is prompted before creating any needed directories
Public Property Get ConfirmMakeDir() As Boolean
    ConfirmMakeDir = m_bConfirmMakeDir
End Property
'Sets if user is prompted for confirmation
Public Property Let ConfirmOperation(bConfirmOperation As Boolean)
    m_bConfirmOperation = bConfirmOperation
End Property
'Gets if user is prompted for confirmation
Public Property Get ConfirmOperation() As Boolean
    ConfirmOperation = m_bConfirmOperation
End Property
'Set custom text displayed in SHFileOperation dialog box
'If text is "" the dialog box displays the name of each file
Public Property Let CustomText(sCustomText As String)
    m_sCustomText = sCustomText
End Property
'Get custom text displayed in SHFileOperation dialog box
Public Property Get CustomText() As String
    CustomText = m_sCustomText
End Property
'Sets if operation affects directories if wildcards (*.*) are specified
Public Property Let IncludeDirectories(bIncludeDirectories As Boolean)
    m_bIncludeDirectories = bIncludeDirectories
End Property
'Gets if operation affects directories if wildcards (*.*) are specified
Public Property Get IncludeDirectories() As Boolean
    IncludeDirectories = m_bIncludeDirectories
End Property
'Set the parent window of the SHFileOperation dialog box
Public Property Let ParentWnd(hParentWnd As Long)
    m_hParentWnd = hParentWnd
End Property
'Get the parent window of the SHFileOperation dialog box
Public Property Get ParentWnd() As Long
    ParentWnd = m_hParentWnd
End Property
'Specifies if destination should be renamed if
'file with same name already exists
Public Property Let RenameOnCollision(bRenameOnCollision As Boolean)
    m_bRenameOnCollision = bRenameOnCollision
End Property
'Gets if destination should be renamed if
'file with same name already exists
Public Property Get RenameOnCollision() As Boolean
    RenameOnCollision = m_bRenameOnCollision
End Property
'Sets if the SHFileOperation dialog box should be hidden
Public Property Let SilentMode(bSilentMode As Boolean)
    m_bSilentMode = bSilentMode
End Property
'Gets if the SHFileOperation dialog box should be hidden
Public Property Get SilentMode() As Boolean
    SilentMode = m_bSilentMode
End Property
'=== Public Methods ========================================
'Moves the source files to the location specified by the
'destination. Returns false if any operations were not
'completed successfully (whether due to errors or user
'actions). If an error occurred, the user has already been
'notified.
Public Function MoveFiles() As Boolean
    MoveFiles = DoOperation(FO_MOVE)
End Function
'Copies the source files to the location specified by the
'destination. Returns false if any operations were not
'completed successfully (whether due to errors or user
'actions). If an error occurred, the user has already been
'notified.
Public Function CopyFiles() As Boolean
    CopyFiles = DoOperation(FO_COPY)
End Function
'Deletes the source files. Returns false if any operations
'were not completed successfully (whether due to errors or
'user actions). If an error occurred, the user has already
'been notified.
Public Function DeleteFiles() As Boolean
    DeleteFiles = DoOperation(FO_DELETE)
End Function
'Renames the source files. Returns false if any operations
'were not completed successfully (whether due to errors or
'user actions). If an error occurred, the user has already
'been notified.
Public Function RenameFiles() As Boolean
    RenameFiles = DoOperation(FO_RENAME)
End Function
'Resets the list of source files
Public Sub ClearSourceFiles()
    Set m_SourceFiles = Nothing
End Sub
'Adds a file to the list of source files
Public Sub AddSourceFile(sFilename As String)
    m_SourceFiles.Add sFilename
End Sub
'Resets the list of destination files
Public Sub ClearDestFiles()
    Set m_DestFiles = Nothing
End Sub
'Adds a file to the list of destination files
Public Sub AddDestFile(sFilename As String)
    m_DestFiles.Add sFilename
End Sub
'=== Private Operations ======================================
'Initialize properties to default values
Private Sub Class_Initialize()
    m_bAllowUndo = DEFAULT_ALLOWUNDO
    m_bConfirmMakeDir = DEFAULT_CONFIRMMAKEDIR
    m_bConfirmOperation = DEFAULT_CONFIRMOPERATION
    m_sCustomText = DEFAULT_CUSTOMTEXT
    m_bIncludeDirectories = DEFAULT_INCLUDEDIRECTORIES
    m_hParentWnd = DEFAULT_PARENTWND
    m_bRenameOnCollision = DEFAULT_RENAMEONCOLLISION
    m_bSilentMode = DEFAULT_SILENTMODE
End Sub
'Execute call to SHFileOperation
Private Function DoOperation(wFunc As Integer) As Boolean
    Dim i As Long, ptr As Long
    Dim shfo As SHFILEOPSTRUCT
    Dim ByteArray() As Byte
    Dim buff1() As Byte, buff2() As Byte, buff3() As Byte
    'Parent window of dialog box--just use 0
    shfo.hwnd = m_hParentWnd
    'Operation to perform
    shfo.wFunc = wFunc
    'Operation flags
    shfo.fFlags = 0
    If m_bAllowUndo Then
        shfo.fFlags = shfo.fFlags Or FOF_ALLOWUNDO
    End If
    If m_bSilentMode Then
        shfo.fFlags = shfo.fFlags Or FOF_SILENT
    End If
    If m_bRenameOnCollision Then
        shfo.fFlags = shfo.fFlags Or FOF_RENAMEONCOLLISION
    End If
    If Not m_bConfirmOperation Then
        shfo.fFlags = shfo.fFlags Or FOF_NOCONFIRMATION
    End If
    If Not m_bConfirmMakeDir Then
        shfo.fFlags = shfo.fFlags Or FOF_NOCONFIRMMKDIR
    End If
    If Not m_bIncludeDirectories Then
        shfo.fFlags = shfo.fFlags Or FOF_FILESONLY
    End If
    If Len(m_sCustomText) > 0 Then
        shfo.lpszProgressTitle = m_sCustomText
        shfo.fFlags = shfo.fFlags Or FOF_SIMPLEPROGRESS
    End If
    'Build 'From' string
    If m_SourceFiles.Count = 0 Then
        Err.Raise vbObjectError + 1000, , "No source files specified
file operation"
    End If
    For i = 1 To m_SourceFiles.Count
        shfo.pFrom = shfo.pFrom & m_SourceFiles(i) & Chr$(0)
    Next i
    'Build 'To' string
    For i = 1 To m_DestFiles.Count
        shfo.pTo = shfo.pTo & m_DestFiles(i) & Chr$(0)
    Next i
    'Test if more than one destination files
    If m_DestFiles.Count > 1 Then
        shfo.fFlags = shfo.fFlags Or FOF_MULTIDESTFILES
    End If
    'Note: Windows packs the SHFILEOPSTRUCT structure but
    '32-bit Visual Basic does not. Therefore, all members
    'following the two-byte fFlags member are offset by
    '2 bytes. To deal with this, we copy structure members
    'to a byte array with the proper alignment and pass
    'the byte array to SHFileOperation.
    ReDim ByteArray(LenB(shfo) - 2)
    CopyMemory ByteArray(0), shfo.hwnd, Len(shfo.hwnd)
    CopyMemory ByteArray(4), shfo.wFunc, Len(shfo.wFunc)
    'Variable-length strings require extra work
    buff1 = StrConv(shfo.pFrom & Chr$(0), vbFromUnicode)
    ptr = VarPtr(buff1(0))
    CopyMemory ByteArray(8), ptr, LenB(ptr)
    buff2 = StrConv(shfo.pTo & Chr$(0), vbFromUnicode)
    ptr = VarPtr(buff2(0))
    CopyMemory ByteArray(12), ptr, LenB(ptr)
    CopyMemory ByteArray(16), shfo.fFlags, Len(shfo.fFlags)
    CopyMemory ByteArray(18), shfo.fAnyOperationsAborted,
Len(shfo.fAnyOperationsAborted)
    CopyMemory ByteArray(22), shfo.hNameMappings,
Len(shfo.hNameMappings)
    buff3 = StrConv(shfo.lpszProgressTitle & Chr$(0), vbFromUnicode)
    ptr = VarPtr(buff3(0))
    CopyMemory ByteArray(26), ptr, LenB(ptr)
    'Call SHFileOperation
    i = SHFileOperation(ByteArray(0))
    'Retrieve fAnyOperationsAborted flag
    CopyMemory shfo.fAnyOperationsAborted, ByteArray(18),
Len(shfo.fAnyOperationsAborted)
    'Return True if SHFileOperation succeeded and no operations aborted
    DoOperation = Not CBool(i Or shfo.fAnyOperationsAborted)
End Function
Ciao
@Alex
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG


cut
Sě un'ape Piaggio!
Ciao, Carlo 


Spiritoso!
Cercavo un'ape perchè me ne bastava UNA, ma accetto anche due API, se 
cortesemente me le invii.
Grazie
Ludus 

 ha scritto nel messaggio 
news:531e7ab15542517377...@mygate.mailgate.org...

Mamma, che spavento 'sto po' di codice!
Domani o lunedì ci provo.
Grazie.
Ludus 

 
lu...@tele2.it
 - Torino
-- 
Roberto
-----------------------------------------------------
il Sito Comune di it.comp.appl.access
http://www.sitocomune.com
----------------------------------------------------

 ha scritto nel 
messaggio news:DkF%e.6599$ID6.1...@twister2.libero.it...

Grazie, ma non credo sia ciò che sto cercando.
Comunque vado a fondo.
Ciao 

 
Ciao Roberto.
No quel demo è solo grafico, ma da quanto ho capito
lui vorrebbe accedere alla funzione nativa di Win che
mostra la Popup di Copia.
La classe che ho postato gestisce proprio quella funzione
senza altri effetti grafici in quanto sono nativi.




Per copiare la cartella usi il riferimento a  FileSystemObject? E quindi a 
Microsoft Scripting Runtime?
Cioè qualcosa del genere?
Private Sub cmdCopia_Click()
Dim fso As FileSystemObject
Dim Source_folder As Folder
Dim Target_folder As Folder
    Set fso = New FileSystemObject
    Set Source_folder = fso.GetFolder(Me.CopiaDa)
    Set Target_folder = fso.GetFolder(Me.CopiaA)
    'qui funziona se la cartella esiste
    MsgBox Source_folder.Size & " byte"
    MsgBox Target_folder.Size 'qui funziona se la cartella esiste
        fso.CopyFolder Me.CopiaDa, _
        Me.CopiaA, _
        (Me.SovrascriviFile.Value = True)
    MsgBox "Ok. Copia Completata"
End Sub
Se è così, ed io non ho ancora provato il risultato, aggiungendo una 
ProgressBar alla maschera, potresti visualizzare la barra di progressione 
con i valori size dei folder sorgenti e destinazione.
Probabilmente il problema sarà intercettare la dimensione del folder di 
destinazione durante la copia.
Ciao, Carlo