[RESOLVED] Copy files if destinationation folder is empty, etc

[Nightwalker83]

Hi,

I have been able to copy the files form one location to another using this code. However, I noticed that if the files as successfully copied in the text file then someone deletes the files they won't be able to restore the files because of the record in the data file "Secussfully copied". Also I need to add functionality to stop the overwritting of files if some of them are newer than the source. This is what I have tried so far:

'copy the files
          If copy = "Copy status:" Or Len(Dir(d, vbDirectory)) = 0 Then VBCopyFiles fullpath & "\*", d

However, that doesn't work! Although, had that code working at one stage today but I can't remember what I put to make it work. I also tried using the datadiff to determine if the destinination file was older than the source files and if so leave it and contniue through the rest of the files. However it still kept copying all the source folder over to the new destination regardless.

Hopefully someone understands what I am getting at.


Nightwalker

[Nightwalker83]

Here is the solution I managed to came up with.

Const VS_FFI_SIGNATURE = &HFEEF04BD
    Const VS_FFI_STRUCVERSION = &H10000
    Const VS_FFI_FILEFLAGSMASK = &H3F&
    Const VS_FF_DEBUG = &H1
    Const VS_FF_PRERELEASE = &H2
    Const VS_FF_PATCHED = &H4
    Const VS_FF_PRIVATEBUILD = &H8
    Const VS_FF_INFOINFERRED = &H10
    Const VS_FF_SPECIALBUILD = &H20
    Const VOS_UNKNOWN = &H0
    Const VOS_DOS = &H10000
    Const VOS_OS216 = &H20000
    Const VOS_OS232 = &H30000
    Const VOS_NT = &H40000
    Const VOS__BASE = &H0
    Const VOS__WINDOWS16 = &H1
    Const VOS__PM16 = &H2
    Const VOS__PM32 = &H3
    Const VOS__WINDOWS32 = &H4
    Const VOS_DOS_WINDOWS16 = &H10001
    Const VOS_DOS_WINDOWS32 = &H10004
    Const VOS_OS216_PM16 = &H20002
    Const VOS_OS232_PM32 = &H30003
    Const VOS_NT_WINDOWS32 = &H40004
    Const VFT_UNKNOWN = &H0
    Const VFT_APP = &H1
    Const VFT_DLL = &H2
    Const VFT_DRV = &H3
    Const VFT_FONT = &H4
    Const VFT_VXD = &H5
    Const VFT_STATIC_LIB = &H7
    Const VFT2_UNKNOWN = &H0
    Const VFT2_DRV_PRINTER = &H1
    Const VFT2_DRV_KEYBOARD = &H2
    Const VFT2_DRV_LANGUAGE = &H3
    Const VFT2_DRV_DISPLAY = &H4
    Const VFT2_DRV_MOUSE = &H5
    Const VFT2_DRV_NETWORK = &H6
    Const VFT2_DRV_SYSTEM = &H7
    Const VFT2_DRV_INSTALLABLE = &H8
    Const VFT2_DRV_SOUND = &H9
    Const VFT2_DRV_COMM = &HA
    Private Type VS_FIXEDFILEINFO
       dwSignature As Long
       dwStrucVersionl As Integer     '  e.g. = &h0000 = 0
       dwStrucVersionh As Integer     '  e.g. = &h0042 = .42
       dwFileVersionMSl As Integer    '  e.g. = &h0003 = 3
       dwFileVersionMSh As Integer    '  e.g. = &h0075 = .75
       dwFileVersionLSl As Integer    '  e.g. = &h0000 = 0
       dwFileVersionLSh As Integer    '  e.g. = &h0031 = .31
       dwProductVersionMSl As Integer '  e.g. = &h0003 = 3
       dwProductVersionMSh As Integer '  e.g. = &h0010 = .1
       dwProductVersionLSl As Integer '  e.g. = &h0000 = 0
       dwProductVersionLSh As Integer '  e.g. = &h0031 = .31
       dwFileFlagsMask As Long        '  = &h3F for version "0.42"
       dwFileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
       dwFileOS As Long               '  e.g. VOS_DOS_WINDOWS16
       dwFileType As Long             '  e.g. VFT_DRIVER
       dwFileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
       dwFileDateMS As Long           '  e.g. 0
       dwFileDateLS As Long           '  e.g. 0
    End Type
                         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 Long ' only used if FOF_SIMPLEPROGRESS, sets dialog title
End Type
    Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
' Available Operations
Private Const FO_COPY = &H2 ' Copy File/Folder
Private Const FO_DELETE = &H3  ' Delete File/Folder
Private Const FO_MOVE = &H1  ' Move File/Folder
Private Const FO_RENAME = &H4  ' Rename File/Folder
' Flags
Private Const FOF_ALLOWUNDO = &H40  ' Allow to undo rename, delete ie sends to recycle bin
Private Const FOF_FILESONLY = &H80  ' Only allow files
Private Const FOF_NOCONFIRMATION = &H10  ' No File Delete or Overwrite Confirmation Dialog
Private Const FOF_SILENT = &H4  ' No copy/move dialog
Private Const FOF_SIMPLEPROGRESS = &H100  ' Does not display file names
    Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
    Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
    Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
    Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)
    Dim Filename As String, Directory As String, FullFileName As String
    Dim StrucVer As String, FileVer As String, ProdVer As String
    Dim FileFlags As String, FileOS As String, FileType As String, FileSubType As String
    Dim copied As String, copy As String, ready As String
    Private Sub DisplayVerInfo()
       Dim rc As Long, lDummy As Long, sBuffer() As Byte
       Dim lBufferLen As Long, lVerPointer As Long, udtVerBuffer As VS_FIXEDFILEINFO
       Dim lVerbufferLen As Long
       '*** Get size ****
       lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
       If lBufferLen < 1 Then
          MsgBox "No Version Info available!"
          Exit Sub
       End If
       '**** Store info to udtVerBuffer struct ****
       ReDim sBuffer(lBufferLen)
       rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
       rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
       MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
       '**** Determine Structure Version number - NOT USED ****
       StrucVer = Format$(udtVerBuffer.dwStrucVersionh) & "." & Format$(udtVerBuffer.dwStrucVersionl)
       '**** Determine File Version number ****
       FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl) & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)
       '**** Determine Product Version number ****
       ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)
       '**** Determine Boolean attributes of File ****
       FileFlags = ""
       If udtVerBuffer.dwFileFlags And VS_FF_DEBUG Then FileFlags = "Debug "
       If udtVerBuffer.dwFileFlags And VS_FF_PRERELEASE Then FileFlags = FileFlags & "PreRel "
       If udtVerBuffer.dwFileFlags And VS_FF_PATCHED Then FileFlags = FileFlags & "Patched "
       If udtVerBuffer.dwFileFlags And VS_FF_PRIVATEBUILD Then FileFlags = FileFlags & "Private "
       If udtVerBuffer.dwFileFlags And VS_FF_INFOINFERRE Then FileFlags = FileFlags & "Info "
       If udtVerBuffer.dwFileFlags And VS_FF_SPECIALBUILD Then FileFlags = FileFlags & "Special "
       If udtVerBuffer.dwFileFlags And VFT2_UNKNOWN Then FileFlags = FileFlags + "Unknown "
       '**** Determine OS for which file was designed ****
       Select Case udtVerBuffer.dwFileOS
          Case VOS_DOS_WINDOWS16
            FileOS = "DOS-Win16"
          Case VOS_DOS_WINDOWS32
            FileOS = "DOS-Win32"
          Case VOS_OS216_PM16
            FileOS = "OS/2-16 PM-16"
          Case VOS_OS232_PM32
            FileOS = "OS/2-16 PM-32"
          Case VOS_NT_WINDOWS32
            FileOS = "NT-Win32"
          Case other
            FileOS = "Unknown"
       End Select
       Select Case udtVerBuffer.dwFileType
          Case VFT_APP
             FileType = "App"
          Case VFT_DLL
             FileType = "DLL"
          Case VFT_DRV
             FileType = "Driver"
             Select Case udtVerBuffer.dwFileSubtype
                Case VFT2_DRV_PRINTER
                   FileSubType = "Printer drv"
                Case VFT2_DRV_KEYBOARD
                   FileSubType = "Keyboard drv"
                Case VFT2_DRV_LANGUAGE
                   FileSubType = "Language drv"
                Case VFT2_DRV_DISPLAY
                   FileSubType = "Display drv"
                Case VFT2_DRV_MOUSE
                   FileSubType = "Mouse drv"
                Case VFT2_DRV_NETWORK
                   FileSubType = "Network drv"
                Case VFT2_DRV_SYSTEM
                   FileSubType = "System drv"
                Case VFT2_DRV_INSTALLABLE
                   FileSubType = "Installable"
                Case VFT2_DRV_SOUND
                   FileSubType = "Sound drv"
                Case VFT2_DRV_COMM
                   FileSubType = "Comm drv"
                Case VFT2_UNKNOWN
                   FileSubType = "Unknown"
             End Select
          Case VFT_FONT
             FileType = "Font"
             Select Case udtVerBuffer.dwFileSubtype
                Case VFT_FONT_RASTER
                   FileSubType = "Raster Font"
                Case VFT_FONT_VECTOR
                   FileSubType = "Vector Font"
                Case VFT_FONT_TRUETYPE
                   FileSubType = "TrueType Font"
             End Select
          Case VFT_VXD
             FileType = "VxD"
          Case VFT_STATIC_LIB
             FileType = "Lib"
          Case Else
             FileType = "Unknown"
       End Select
    End Sub
    Private Sub Form_Load()
        'set the file
        Filename = "kernel32.dll"
        Directory = "c:\windows\system\"
        FullFileName = Directory + Filename
        'set graphics mode to persistent
        Me.AutoRedraw = True
        'retrieve the information
        DisplayVerInfo
        'show the results
        Me.Print "Full filename: " + FullFileName
        Me.Print "File version: " + FileVer
        Me.Print "Product version: " + ProdVer
        Me.Print "File flags: " + FileFlags
        Me.Print "File OS: " + FileOS
        Me.Print "File type: " + FileType + IIf(FileSubType = "", "", " (" + FileSubType + ")")
          saveversiondata
        copym
        datecheck
    End Sub
 
Private Sub saveversiondata()
ff = FreeFile
 Open App.Path & "\data.txt" For Output As #ff
    Print #ff, "Full filename: " + FullFileName
    Print #ff, "File version: " + FileVer
    Print #ff, "Product version: " + ProdVer
    Print #ff, "File flags: " + FileFlags
    Print #ff, "File OS: " + FileOS
    Print #ff, "File type: " + FileType + IIf(FileSubType = "", "", " (" + FileSubType + ")")
    copied = "No Version Info available!"
    Print #ff, copied
 Close #ff
End Sub
 
Private Sub loadversiondata()
ff = FreeFile
Open App.Path & "\data.txt" For Input As #ff
 Input #ff, FullFileName
 Input #ff, FileVer
 Input #ff, ProdVer
 Input #ff, FileFlags
 Input #ff, FileOS
 Input #ff, FileType
 Input #ff, copy
 ready = copy
 Close #ff
 'MsgBox (FileVer)
End Sub
 
Private Sub copym()
     loadversiondata
If Len(Dir("g:\New folder\")) = 0 Or ready = "No Version Info available!" Then VBCopyFiles "c:\.rnd", "g:\New folder\.rnd"
End Sub
Private Sub datecheck()
Dim file1 As String, file2 As String, ans As Integer, newfile As String, iCount As Integer, Count As Integer
iCount = 0
MyName = Dir("C:\New folder\", vbDirectory)   ' Retrieve the first entry.
    Do While MyName <> ""   ' Start the loop.
       ' Ignore the current directory and the encompassing directory.
      If MyName <> "." And MyName <> ".." Then
          ' Use bitwise comparison to make sure MyName is a directory.
          If (GetAttr("C:\New folder\" & MyName) And vbDirectory) = vbDirectory Then iCount = iCount + 1 'it represents a directory.
             fullpath = "C:\New folder\" & MyName 'Set the path.
            End If
             MyName = Dir   'Get next entry.
       Loop
       Count = 0
dest = Dir("G:\New folder\", vbDirectory)   ' Retrieve the first entry.
    Do While dest <> ""   ' Start the loop.
       ' Ignore the current directory and the encompassing directory.
      If dest <> "." And dest <> ".." Then
          ' Use bitwise comparison to make sure MyName is a directory.
          If (GetAttr("g:\New folder\" & dest) And vbDirectory) = vbDirectory Then Count = Count + 1 'it represents a directory.
             newfile = "g:\New folder\" & dest 'Set the path.
            End If
             dest = Dir   'Get next entry.
       Loop
'*'*'*'get date and time for each file'*'*'*'
file1 = FileDateTime(fullpath) '' this will be the server one
file2 = FileDateTime(newfile)
'*'*'*'start comparison'*'*'*'
If Format(file1, "yyyy") = Format(file2, "yyyy") Then
    If Format(file1, "mm") = Format(file2, "mm") Then
        If Format(file1, "dd") = Format(file2, "dd") Then
            If Format(file1, "hh") = Format(file2, "hh") Then
                If Format(file1, "min") = Format(file2, "min") Then
                    MsgBox "Same File"
                    Exit Sub
                End If
            End If
        End If
    End If
End If
VBCopyFiles "c:\.rnd", "g:\New folder\.rnd"
End Sub
Private Sub VBCopyFiles(ByRef strSource As String, ByRef strTarget As String)
 
    Dim op As SHFILEOPSTRUCT
    With op
        .wFunc = FO_COPY ' Set function
        .pTo = strTarget  ' Set new path
        .pFrom = strSource ' Set current path
        .fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION Or FOF_FILESONLY
    End With
    ' Perform operation
    SHFileOperation op
End Sub

Edit:

I decided to post the full working example instead.

[Doogle]

However, that doesn't work!

What do you mean by that statement ? Are you getting an error of some sort or is the Logic wrong ?

Not too sure what you're doing, but

If copy = "Copy status:" Or Len(Dir(d, vbDirectory)) = 0 Then VBCopyFiles fullpath & "\*", d

will execute VBCopyFiles if either Copy = "Copy status:" is True or the Directory doesn't exist.
My guess is that you 'got it working' before by testing 'copy' for some other value

EDIT: I see I was too late !!

[Nightwalker83]

Not too sure what you're doing, but

I had the copy function in place as linked to in the first post but I needed to only allow the files to be copied if certain conditions were met. Those conditions being that certion data was in the text file if the destination folder was empty and whether the destination files were older that the source files.

[incidentals]

please tell me about the empty folder again

do you mean when putting file into the folder you could not do if folder was empty

or do you mean when putting a file into a folder and the folder was not there

as for the data in files

do you mean if data in the file you are about to copy

or do you mean if the data exists in the file you are about to replace

and finally

the age of source files

the way to check the age of the files will vary due to how you save that date

if you vary the version number of a file then that is clear in the name of the file - no fancy filersystem stuff to review

if it is on date of production that could be in the name too or in the header of the file (1st record)

or you could delve into the filersystem stuff and get the "last save time" property "last modified", "created" information

answering these questions will make it easier to help you

here to talk

[Nightwalker83]

please tell me about the empty folder again

The files get put in the folder then the user starts the program then for some reason they remove the files (or they get deleted). As you can see in the second post that is the code I came up with. Now, to get it working with my actual program not just a quick demo.