[AccessD] A2K:Get file name after drag and drop_SecondSend

Sorry to say the example was not that detailed.  I'd be happy to provide some real detail as needed.  One point I need to reiterate is that my testing was in Access 2003 and the entire success of the drag and drop procedure is predicated on being able to rely on the VBA AddressOf procedure that didn't exist in Access 97, though it was available in VB 5 and up.  I stated this in my original reply.  My understanding was that AddressOf became available in VBA with version 6 (A2K).  I've got an A2K file list form/subform example I built a few years ago to which I could add the d & d functionality to validate how it works in A2K.  My personal machines are all currently A2K but I rarely use them for work given that everything we do is by VPN.

 

In order to make the file name and path returned by the example code at the link (as modified to work with an Access form by passing a form variable) do something useful, you need some additional code to do the grunt work.  My subform gets a string with the destination path from the code and I already suggested how to get the file name from the string returned by the drop procedure.  To do something useful like copy all the files or all files with a particular extension below a path and sub directories, you need to do a bit more work.

 

One example for shelling a Robocopy of everything below a path and writing a log file at the destination, and waiting for the copy to be done prior to processing anything moved follows:

 

Public Sub MovePath(strSource As String, strDest As String)

    ShellWait "Robocopy.exe """ & strSource & """ " & strDest & " /E /V /log+:" & strDest & "\Robocopy.log"

End Sub

 

If the attributes of the dragged item in Explorer are returnedAttributes & vbDirectory = vbDirectory, you can call the above code to move files and create/append information about the files and success or failure to copy to a log file in response to a folder being dropped on a subform containing the drop code.  You could lose the /log+ switch.  The whole trick is getting the quotes right in order to call from VBA.  There's lots of help on the switches and options for Robocopy.


The MovePath procedure depends on Robocopy.exe being found in a folder in the Path statement, otherwise you need to explicity provide the path to Robocopy.exe.  The log file will show files that can't be copied because they are open or for any other reason.

 

If you want to run the Dos Dir command to set up a text file for parsing, you can generally use Environ$("comspec") and /C to run commands.  On the server I'm working on Environ returns:  C:\WINDOWS\system32\cmd.exe.  For example, to write a file list of every file with the file extension '.pee' below a base path:

 

ShellWait Environ$("Comspec") & " /C dir " & """D:\GOM\Docs\Edmonton\2009\*.pee""" & " /S > " & """D:\GOM\Docs\Peefiles.txt"""


Once that is completed you can call something like the following procedure to add the names and paths of the .pee files to a table by parsing the Peefiles.txt file:

 

Sub FileParse()
    Dim strTextLine As String
    Dim strFilename As String
    Dim intFileHandle As Integer
    Dim strPath As String
    Dim strfile As String
    Dim lngStart As Long
    Dim r As DAO.Recordset
    Dim db As DAO.Database

 

    strFilename = "D:\GOM\Docs\Peefiles.txt"
    If Dir(strFilename) = "" Then Exit Sub
    Set db = CurrentDb
    Set r = db.OpenRecordset("tblPeeFiles")
    intFileHandle = FreeFile

    Open strFilename For Input As #intFileHandle
    Do While Not EOF(intFileHandle)
        Line Input #intFileHandle, strTextLine  ' Read line into variable
        lngStart = InStr(strTextLine, "Directory Of ")
        If lngStart Then
            'Folder path follows

            strPath = Mid$(strTextLine, 15) & "\"
        End If
        If Right$(strTextLine, 4) = ".pee" Then
            'File name follows

            strfile = Mid$(strTextLine, 40)
            If Len(Dir(strPath & strfile)) Then
                r.AddNew
                r(1) = strPath & strfile
                r.Update
            Else
                Debug.Print "Invalid:  " & strPath & strfile
            End If
        End If
    Loop
    Close #intFileHandle
End Sub

 

I'm using something very like the code above to populate a temporary table in order to migrate a few terabytes of files to a new server to various different paths based on some record attributes.

 

You need shellwait in order to pause the code until it has completed the shelled portion of work.

 

Variables & Declarations:

 

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal _
  dwMilliseconds As Long) As Long

 

Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal _
    lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, lpStartupInfor As STARTUPINFO, lProcessInformation As _
    PROCESS_INFORMATION) As Long

 

Private Const STARTF_USESHOWWINDOW& = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

 

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

 

The ShellWait procedure:

 

Public Sub ShellWait(pathname As String, Optional WindowStyle As Long)
    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim ret As Long

    With start
        .cb = Len(start)
        If Not IsMissing(WindowStyle) Then
            .dwFlags = STARTF_USESHOWWINDOW
            .wShowWindow = WindowStyle
        End If
    End With
    ret& = CreateProcessA(0&, pathname, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    ret& = WaitForSingleObject(proc.hProcess, INFINITE)
    CloseHandle proc.hProcess
End Sub

Ciao Jürgen Welz

 
> From: darren at activebilling.com.au
> To: accessd at databaseadvisors.com
> Date: Fri, 15 Jan 2010 09:23:03 +1100
> Subject: Re: [AccessD] A2K:Get file name after drag and drop_SecondSend
> 
> Hi Jürgen
> 
> Wow this is great and very detailed - many thanks
> I will work on this again tonight - I'll let you know how it turns out
> 
> Again - Many many thanks, you've put in a lot of effort on my behalf - I truly
> am most grateful.
> 
> :-)
 		 	   		  
_________________________________________________________________