Selecting files & folders in a textbox form by dragging them from Windows Explorer.

[xavier.batlle]

Selecting files/folders using Windows API.

I don't think this topic is new, but I couldn't find an easy way to drag one or more files from Windows Explorer and drop them into a textbox, so after doing some AI research, I ended up with this database.
Warning!
In 32 bit MS Access this code is likely to freeze Access if it's executed after opening the VBE or after editing the code.

 

[MajP]

I did not look at your solution yet but some ActiveX controls support this
Post in thread 'File Attachement Field' https://www.access-programmers.co.uk/forums/threads/file-attachement-field.334511/post-1972302

 

[MsAccessNL]

ActiveX listbox6.0 reacts to drag drop. You can catch the folder/file info with vba

 

[MsAccessNL]

Private Sub lvwDD_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    'Set  OleDropMode =1 (DropManual)
    'https://msdn.microsoft.com/en-us/library/aa244109(v=vs.60).aspx
    'Debug.Print Effect 'attachment = 5, excel/png = 7
    
    On Error GoTo Handle_Error
    Dim i As Long
    Dim iPos As Integer
    Dim bFound As Boolean: bFound = True
    Dim FolderName As Variant
    
    Const vbCFFiles = 15
    '    Call GetField 'get idfield name and lProjectNr
    '    If lProjectNr = 0 Then
    '        MsgBox "Er is geen ProjectNr gevonden om de betreffende Folder te selecteren"
    '        GoTo Handle_Error
    '    End If
    
    sProjectFolder = CurrentProject.Path & "\ToDoDocuments"
    'If Environ("UserName") = "Daniel" Then
    If Len(Dir(sProjectFolder, vbDirectory)) = 0 Then MkDir (sProjectFolder)
  
    
    If Data.getformat(vbCFFiles) Then
        For i = 1 To Data.Files.Count
            sPath = Data.Files(i)
            iPos = InStrRev(sPath, "\")
            sDocNaam = Right(sPath, Len(sPath) - iPos)
            'sPath = Mid(sPath, 1, iPos)
            
            If CheckFolder = False Then
                bFound = False
                MsgBox "Folder is niet gevonden, " & sDocNaam & " is niet geimporteerd1"
                GoTo Handle_Error
            End If
            sNewPath = sProjectFolder & "\" & sDocNaam
            Call CopyFile(sPath, sNewPath)
            sPath = sNewPath
            'Call GetField
            Call IfExist
        Next i
    Else
        If Effect = 5 Or Effect = 7 Then '->outlook attachment
            If CheckFolder = False Then
                bFound = False
                MsgBox "Folder is niet gevonden, " & sDocNaam & " is niet geimporteerd!"
            Else
                Call SaveAttachment
            End If
        Else
            MsgBox "No files have been imported!"
        End If
    End If
    Me.Requery
    
Handle_Exit:
    Exit Sub
Handle_Error:
    If bFound = False Then
        Resume Handle_Exit
    ElseIf Err.Number = 58 Then ' file already exist in destenation
        Resume Next
    Else
        MsgBox Err.Description & ": " & Err.Number
        Resume Handle_Exit
    End If
End Sub