HI.
I have an very large folder(400 Mb) its contain up to seven or more levels of subfolders and each with files inside , I need copy this to another drive in order to make backup .
I do not want to use Excel CopyFolder function , I want if is posible Api call in order to fastest process.
1)one way to full copy
2)other way to copy only newest files
Thanks in advance.
asihuay

Hi, try the FileSystemObject.CopyFolder method. This works for me, and over UNC also
Kieron


____________________________
Build it better, faster, quicker, easier.. then fix it (non-offical MS mission statement)

Hi, try the FileSystemObject.CopyFolder method. This works for me, and over UNC also
Kieron


____________________________
Build it better, faster, quicker, easier.. then fix it (non-offical MS mission statement)

Hi Kieron
Yes I try FSO but folder copy with windows explorer take half time, this is the razon I need API process.
asihuay

The following code came from numerous sources, with modifications for a place I worked at. not sure if it'd work for you though.

TransferFile is the copy
CheckforUpdates checks the file date

It'd have to be changed based on your situation, but it's fairly easy.


Option Explicit
' Below is for Launching the Control Panel
    Public Declare Function GetDesktopWindow Lib "user32.dll" () As Long
    Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'API constants
    Public Const SW_SHOWNORMAL = 1

    Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
    
    Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
    End Type
    
    Private Const GENERIC_WRITE = &H40000000
    Private Const OPEN_EXISTING = 3
    Private Const FILE_SHARE_READ = &H1
    Private Const FILE_SHARE_WRITE = &H2


    Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
    Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
    Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

' Below is used for Copying files
    Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As Any) As Long

    Public Declare Sub SHFreeNameMappings Lib "shell32.dll" (ByVal hNameMappings As Long)
        
' Used for both Call types
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

    Public Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As FO_Functions
        pFrom As String
        pTo As String
        fFlags As FOF_Flags
        fAnyOperationsAborted As Long
        hNameMappings As Long
        lpszProgressTitle As String 'only used if FOF_SIMPLEPROGRESS
    End Type

    Public Enum FO_Functions
        FO_MOVE = &H1
        FO_COPY = &H2
        FO_DELETE = &H3
        FO_RENAME = &H4
    End Enum

    Public Enum FOF_Flags
        FOF_MULTIDESTFILES = &H1
        FOF_CONFIRMMOUSE = &H2
        FOF_SILENT = &H4
        FOF_RENAMEONCOLLISION = &H8
        FOF_NOCONFIRMATION = &H10
        FOF_WANTMAPPINGHANDLE = &H20
        FOF_ALLOWUNDO = &H40
        FOF_FILESONLY = &H80
        FOF_SIMPLEPROGRESS = &H100
        FOF_NOCONFIRMMKDIR = &H200
        FOF_NOERRORUI = &H400
        FOF_NOCOPYSECURITYATTRIBS = &H800
        FOF_NORECURSION = &H1000
        FOF_NO_CONNECTED_ELEMENTS = &H2000
        FOF_WANTNUKEWARNING = &H4000
    End Enum

    Public Type SHNAMEMAPPING
        pszOldPath As String
        pszNewPath As String
        cchOldPath As Long
        cchNewPath As Long
    End Type

' Below is for checking File versions
    Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As Long) As Long
    Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, ByVal strSrc As Any, ByVal lBytes As Long)
    Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long) As Long
    Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long
    Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As Long, lLen As Long) As Long
    Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long
    Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String)
    
    Private Const MASTER_DRIVE = "APP5-DC-PLTTire SpecCardexesNon-Tuber Cardex SP1a"
    Private Const MASTER_DB_DRIVE = "APP5-DC-PLTTire SpecCardexesCardex Database Files"
    
    
Public Function SHFileOP(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
'This uses a method suggested at MSKB to
'ensure that all parameters are passed correctly
'Call this wrapper rather than the API function directly
    Dim result As Long
    Dim lenFileop As Long
    Dim foBuf() As Byte

    lenFileop = LenB(lpFileOp)
    ReDim foBuf(1 To lenFileop) 'the size of the structure.

'Now we need to copy the structure into a byte array
    Call CopyMemory(foBuf(1), lpFileOp, lenFileop)

'Next we move the last 12 bytes by 2 to byte align the data
    Call CopyMemory(foBuf(19), foBuf(21), 12)
    result = SHFileOperation(foBuf(1))

    SHFileOP = result
End Function

Public Function StringFromBuffer(buffer As String) As String
    Dim nPos As Long

    nPos = InStr(buffer, vbNullChar)
    If nPos > 0 Then
        StringFromBuffer = Left$(buffer, nPos - 1)
    Else
        StringFromBuffer = buffer
    End If
End Function

Public Sub TransferFileToRecycleBin(Filename As String, Optional Confirm As Boolean = False, Optional Silent As Boolean = True)
    Dim FileOp As SHFILEOPSTRUCT
    'fills the file operation structure
    With FileOp
        .wFunc = FO_DELETE
        .pFrom = Filename
        '.fFlags = FOF_ALLOWUNDO
        If Not Confirm Then .fFlags = .fFlags + FOF_NOCONFIRMATION
        If Silent Then .fFlags = .fFlags + FOF_SILENT
    End With
    SHFileOperation FileOp
End Sub

Public Sub TransferFile(ByVal Source As String, ByVal Destination As String, Optional ByVal bMove As Boolean = False)
    Dim lRet As Long
    Dim FileOp As SHFILEOPSTRUCT
    Dim result As Long
        With FileOp
        .hwnd = 0
        If bMove Then
            .wFunc = FO_MOVE
        Else
            .wFunc = FO_COPY
        End If
        .pFrom = Source & vbNullChar & vbNullChar
        .pTo = Destination & vbNullChar & vbNullChar
        .lpszProgressTitle = "Transfering..."
        .fFlags = FOF_NOCONFIRMATION
    End With
    
    lRet = SHFileOP(FileOp)
    
    If result <> 0 Then 'Operation failed
        MsgBox Err.LastDllError 'Show the error returned from the API.
    Else
        If FileOp.fAnyOperationsAborted <> 0 Then
            MsgBox "Operation Failed"
        End If
    End If
End Sub

' /******************************
'  * File Version/Date Checking *
'  */****************************
Public Function GetFileDateTime(ByVal sFile As String) As Date
    On Error Resume Next
    Dim lngHandle As Long
    Dim Ft1 As FILETIME
    Dim Ft2 As FILETIME
    Dim SysTime As SYSTEMTIME
    Dim dDate As Date
    Dim dTime As Date
    lngHandle = CreateFile(sFile, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
    If lngHandle > 0 Then
        'Get the file's time
        GetFileTime lngHandle, Ft1, Ft1, Ft2
        'Convert the file time to the local file time
        FileTimeToLocalFileTime Ft2, Ft1
        'Convert the file time to system file time
        FileTimeToSystemTime Ft1, SysTime
        With SysTime
            dDate = LongMonth(.wMonth) & "/" & .wDay & "/" & .wYear
            dTime = .wHour & ":" & .wMinute & ":" & .wSecond
        End With
        GetFileDateTime = CDate(dDate & "  " & dTime)
    End If
    CloseHandle lngHandle
End Function

Public Function GetFileDescription(ByVal sFile As String) As String
    Dim lVerSize As Long
    Dim lTemp As Long
    Dim lRet As Long
    Dim lRetDt As Long
    Dim bInfo() As Byte
    Dim lpBuffer As Long
    Dim sDesc As String
    Dim sKEY As String

    lVerSize = GetFileVersionInfoSize(sFile, lTemp)
    ReDim bInfo(lVerSize)
    If lVerSize > 0 Then
    lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VarPtr(bInfo(0)))
        If lRet <> 0 Then
            sKEY = GetNLSKey(bInfo)
            lRet = VerQueryValue(VarPtr(bInfo(0)), sKEY & "FileVersion", lpBuffer, lVerSize)
            If lRet <> 0 Then
                sDesc = Space$(lVerSize)
                lstrcpyn sDesc, lpBuffer, lVerSize
                GetFileDescription = StringFromBuffer(sDesc)
            End If
        End If
    End If
End Function


Public Function GetNLSKey(byteVerData() As Byte) As String
    Static strLANGCP As String
    Dim lpBufPtr As Long
    Dim strNLSKey As String
    Dim fGotNLSKey As Integer
    Dim intOffset As Integer
    Dim lVerSize As Long
    Dim lTmp As Long
    Dim lBufLen As Long
    Dim lLCID As Long
    Dim strTmp As String

    On Error GoTo GNLSKCleanup
    If VerQueryValue(VarPtr(byteVerData(0)), "VarFileInfoTranslation", lpBufPtr, lVerSize) <> 0 Then
        If Len(strLANGCP) = 0 Then
            lLCID = GetUserDefaultLCID()
            If lLCID > 0 Then
                strTmp = Space$(8)
                GetLocaleInfoA lLCID, 11, strTmp, 8
                strLANGCP = StringFromBuffer(strTmp)
                Do While Len(strLANGCP) < 4
                    strLANGCP = "0" & strLANGCP
                Loop
                GetLocaleInfoA lLCID, 9, strTmp, 8
                strLANGCP = StringFromBuffer(strTmp) & strLANGCP
                Do While Len(strLANGCP) < 8
                    strLANGCP = "0" & strLANGCP
                Loop
            End If
        End If
        If VerQueryValue(VarPtr(byteVerData(0)), strLANGCP, lTmp, lBufLen) <> 0 Then
            strNLSKey = strLANGCP
        Else
            For intOffset = 0 To lVerSize - 1 Step 4
                CopyMemory lTmp, ByVal lpBufPtr + intOffset, 4
                strTmp = Hex$(lTmp)
                Do While Len(strTmp) < 8
                    strTmp = "0" & strTmp
                Loop
                strNLSKey = "StringFileInfo" & Right$(strTmp, 4) & Left$(strTmp, 4)
                If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
                    fGotNLSKey = True
                    Exit For
                End If
            Next
            If Not fGotNLSKey Then
                strNLSKey = "StringFileInfo40904E4"
                If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
                    fGotNLSKey = True
                End If
            End If
        End If
    End If
GNLSKCleanup:
    If fGotNLSKey Then
        GetNLSKey = strNLSKey
    End If
End Function


Public Function CheckForUpdates(ByVal sFileName As String) As Boolean
    On Error GoTo ErrorHandling
    Dim Current As String
    Dim Master As String
    Dim dCurrent As Date
    Dim dMaster As Date
' Only transfer files if newer ones exist
    If LCase(Right(sFileName, 3)) = "exe" Then
        Current = GetFileDescription(App.Path & "" & sFileName)
        Master = GetFileDescription(MASTER_DRIVE & sFileName)
        CheckForUpdates = IIf(Current >= Master, False, True)
    ElseIf LCase(Right(sFileName, 3)) = "mdb" Then
        dCurrent = GetFileDateTime(App.Path & "" & sFileName)
        dMaster = GetFileDateTime(MASTER_DB_DRIVE & sFileName)
    ' Find time difference in files
        If dMaster > dCurrent Then
        ' if the master newer, then update
            CheckForUpdates = True
        ElseIf dMaster = dCurrent Then
        ' If times are the same, don't update
            CheckForUpdates = False
'        ElseIf Abs(DateDiff("n", dCurrent, dMaster)) <= 5 Then
'        ' if current file is less than 5 min newer, then update
'            CheckForUpdates = True
        Else
            CheckForUpdates = False
        End If
    End If
    Exit Function
ErrorHandling:
    CheckForUpdates = True
End Function

Private Function LongMonth(ByVal iMonth As Integer) As String
    Select Case iMonth
        Case 1
            LongMonth = "January"
        Case 2
            LongMonth = "February"
        Case 3
            LongMonth = "March"
        Case 4
            LongMonth = "April"
        Case 5
            LongMonth = "May"
        Case 6
            LongMonth = "June"
        Case 7
            LongMonth = "July"
        Case 8
            LongMonth = "August"
        Case 9
            LongMonth = "September"
        Case 10
            LongMonth = "October"
        Case 11
            LongMonth = "November"
        Case 12
            LongMonth = "December"
    End Select
End Function


[Edited by JLRodgers on 30-09-2002 at 11:42 PM GMT]

Hi JLRodgers
Thanks for the code , Today I try this.
asihuay