Attribute VB_Name = "modCommonFileDir"
Option Explicit

Public Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Const F0_DELETE = &H3
Public Const F0F_ALLOWUNDO = &H40
Public Const F0F_CREATEPROGRESSDLG As Long = &H0

Public Declare Function MakeSureDirectoryPathExists Lib "IMAGEHLP.DLL" (ByVal DirPath As String) As Long
Public Const strAmptekCommonFilePath As String = "C:\Program Files\Common Files\Amptek"

'creates common files directory, copies selected files to dir
Public Sub CopyFilesToCommonFilesDirectory(strCmnFileDir As String)
    On Error Resume Next
    Dim vFilePath As Variant
    Dim SourceFile As String
    Dim DestinationFile As String
    Dim FileName As String
    
    'if dir does not exist, create common files directory
    If (vbCreateDirPath(strCmnFileDir)) Then    'get selections from search form
        Set colSearchResults = Nothing          'clear selections collection
        Set colSearchResults = New Collection
        Load frmSelectPMCA
        frmSelectPMCA.Show vbModal
        If (colSearchResults.Count > 0) Then
            For Each vFilePath In colSearchResults
                SourceFile = vFilePath                          ' Define source file path.
                DestinationFile = strCmnFileDir                 ' copy common file dir root
                If Right(DestinationFile, 1) <> "\" Then        'verify separator exists
                    DestinationFile = DestinationFile & "\"
                End If
                DestinationFile = DestinationFile & Dir(SourceFile) ' Define target file path.
                FileCopy SourceFile, DestinationFile            ' Copy source to target.
            Next
        End If
    End If
End Sub

Public Function CreateDirPath(strDirPath As String) As Boolean
    On Error Resume Next
    Dim strNewPath As String
    strNewPath = strDirPath
    CreateDirPath = False
    If (Dir(strDirPath, vbDirectory) <> "") Then
        CreateDirPath = True
        Exit Function
    End If
    If Right(strNewPath, 1) <> "\" Then
        strNewPath = strNewPath & "\"
    End If
    If MakeSureDirectoryPathExists(strNewPath) = 0 Then
        CreateDirPath = False
    Else
        CreateDirPath = True
    End If
    If (Dir(strDirPath, vbDirectory) = "") Then
        CreateDirPath = False
    Else
        CreateDirPath = True
    End If
End Function

Public Function vbCreateDirPath(strDirPath As String) As Boolean
    On Error Resume Next
    Dim i As Long
    Dim strNewPath As String
    vbCreateDirPath = False
    If (Dir(strDirPath, vbDirectory) <> "") Then
        vbCreateDirPath = True
        Exit Function
    End If
    Do
        i = InStr(i + 1, strDirPath & "\", "\")
        strNewPath = Left(strDirPath, i - 1)
        If Right(strNewPath, 1) <> ":" And Dir(strNewPath, vbDirectory) = "" Then
            MkDir strNewPath
        End If
    Loop Until i >= Len(strDirPath)
    If (Dir(strDirPath, vbDirectory) = "") Then
        vbCreateDirPath = False
    Else
        vbCreateDirPath = True
    End If
End Function

Public Sub DeleteToRecycleBin(strFileName As String)
    Dim FileOperation As SHFILEOPSTRUCT
    Dim lReturn As Long
    On Error GoTo DeleteToRecycleBin_Err
    FileOperation.wFunc = F0_DELETE
    FileOperation.pFrom = strFileName
    FileOperation.fFlags = F0F_ALLOWUNDO + F0F_CREATEPROGRESSDLG
    lReturn = SHFileOperation(FileOperation)
    Exit Sub
DeleteToRecycleBin_Err:
    MsgBox Err.Description
End Sub