Move the selected file with acCmdInsertHyperlink (2 Viewers)

LeoM

Member
Local time
Today, 00:53
Joined
Jun 22, 2023
Messages
77
Good morning, everyone.
I have a form which I use to store some selected files (any type) in a table. In the form there is a button which allow me to open "Explorer" and select the file, the code i use in the "Click" event is the following:

Me.LinkName.SetFocus
RunCommand acCmdInsertHyperlink


For information LinkName is the field (Type Hyperlink) of the table I use to store the linked files.

The scope is to avoid user select document in local disk (no visible to other users which use the interface) so my idea it was to automatically move the linked file to a specific network folder (we can call L:\Local).

Any suggestion/idea how to do? Please consider that the linked file i got on the Click event (after i select the file) is something like this:
"..\..\..\..\..\..\Local\Discipline Table.xlsx#..\..\..\..\..\..\Local\Discipline%20Table.xlsx#" (refer to the "Discipline Table.xlsx" file located in the path C:\Local\.

Thank you in advance,
Cheers
 
A bit confused by your description so:
1. Your users can select a file (using file explorer).
2. Selecting a file moves it to a network folder (nominally L:\Local?)
3. Having moved the file a record is automatically created in your table in which the hyperlink is stored (in field linkname)? - using your click event code?
4. However the hyperlink is apparently not "correct" and so clicking on the control in the form displaying linkname does not work? ie the file is not found / the file is not opened in a browser or by the application associated with the extension.

Assuming the file is copied or moved correctly - your hyperlink is not well constructed. My own approach to this is to capture the full path and the displayed name separately in two fields: parsing the full path to get the displayed name (initially as the filename - no extension). Then in the application to show the display name as a clickable link that opens the file (not a hyperlink but displayed as if it is). Is that what you are seeking?

You may also find this advice useful/ explanatory : http://allenbrowne.com/func-GoHyperlink.html

1752744372037.png
 
Last edited:
Hi, thanks for the answer/suggestion and sorry if i was confused. You are righ, in my explanation i forgot to say that, once i move the file, i should update the link (with the new one). Just to summarize:
1. I have a sub form (the source is a table with 2 fields: ID and LINKED_DOC (which is type hyperlink). The ID i use to refer to the record in my main form.
2. The user can add one or more document (as link)
The problem which i see (maybe is easily solved) is that if any user decides to link a file located in own disk "local" file (e.g. located in C: Drive) other users (which also use the same interface, I have BE separated) they may not open that file because is a "local" file. Now, i don't know if this can be avoided with your process or by using the GoHyperlink procedure (thank you, really very useful). I can also decide to not use "hyperlink" field, important for me to solve the "possible" issue.
Could be possible to have the script you use to:
- Select the file
- Collect the path
- Collect the file
- How to combine and show the clickable link that opens the file? (question: if the file is local? can be open anyway from anyone?)
Thanks again,
Cheers
 
Take a look at FileSystemObject.


Some of the methods you could use:

 
you can create a function that will Move the file once a Hyperlink has been selected from the screen.
copy the code in a Module:
Code:
Public Function fnMoveHyperLink(ByVal hyperLnk As String, ByVal TargetPath As String)

    Dim lnk As String
    Dim fil As String
    Dim newPath As String
    Dim var As Variant
    var = Split(hyperLnk, "#")
    ' get the Link portion
    lnk = var(1)
    ' add path if there is none
    If InStr(lnk, "\") = 0 Then
        lnk = Environ$("userprofile") & "\documents\" & lnk
    End If
    ' get the source filename
    fil = Mid$(lnk, InStrRev(lnk, "\") + 1)
    TargetPath = Replace$(TargetPath & "\", "\\", "\")
    newPath = TargetPath & fil
    ' erase same file on destination folder
    If Len(Dir$(newPath)) <> 0 Then
        Kill newPath
    End If
    ' move the file
    With CreateObject("Scripting.FileSystemObject")
        .MoveFile lnk, newPath
    End With
    'return the new link
    var(1) = newPath
    fnMoveHyperLink = Join(var, "#")
End Function

now change your original code to:

Code:
Private Sub YourButtonName_Click()
On Error GoTo err_handler:
Me.LinkName.SetFocus
RunCommand acCmdInsertHyperlink

If Not IsNull(Me.LinkName) Then
    Me.LinkName = fnMoveHyperLink(Me.LinkName, "L:\Local")
End If
err_handler:
End Sub
 
I use code like the following to move or copy files to destination folders. If a file name already exists it will add a number to the file name like MyFile(1).txt, etc.

Code:
Public Sub MoveFileRename(SourceFile As String, DestFolder As String, Optional CopyF As Boolean = False)

    If Right(DestFolder, 1) <> "\" Then DestFolder = DestFolder & "\"
    
    Dim fso As New FileSystemObject
    Dim pthA As String, pthB As String, pthC As String, Fpath As String
    Dim TName As String, Ext As String, i As Integer
    
    pthA = SourceFile
    pthB = DestFolder

    TName = fso.GetBaseName(pthA)
    Ext = fso.GetExtensionName(pthA)
    
    pthC = fso.BuildPath(pthB, TName & "." & Ext)

    If fso.FileExists(pthC) Then
    
        For i = 1 To 100
            pthC = fso.BuildPath(pthB, TName & "(" & i & ")" & "." & Ext)
            If Not fso.FileExists(pthC) Then
                Fpath = pthC
                Exit For
            End If
        Next
    Else
        Fpath = pthB
    End If

    If CopyF = True Then  'either move or copy file to location
        fso.CopyFile pthA, Fpath, False
    Else
        fso.MoveFile pthA, Fpath
    End If
    
End Sub
 
The reason I do not use the hyperlink is because I am dealing with files - not links to web pages/ sites.

Are you proposing that users may save links to their local files, which are not available to others, and links to files which are shared on the network under L:\local? If that is the case you would need some marker field to indicate the true local owner of the file (which cannot be accessed by others and would be filtered out of the shared list).

In addition as said I did not use hyperlink so the mechanism is to open the file using the file association, and your current table structure is inadequate for this. Consider something like
1752748643542.png


I store files off a folder relative to the BE path - dedicated to the person in question, rather than shared, so adjust to suit - something like:
Code:
Private Sub btnSelectDoc_Click()
'   Select a document to link to the current person

Dim PID                     As Integer
Dim sDocPath                As String
Dim bePath                  As String
Dim sPersonName             As String
Dim sFileName               As String
Dim sFile                   As String     ' the selected file
Dim sFolder                 As String
Dim setUser                 As String
Dim SetDt                   As Date
Dim strSql                  As String

Dim strModuleName           As String
Dim strSubName              As String
   
    On Error GoTo ErrorHandler

    setUser = Environ("Username")
    SetDt = Now()
   
    bePath = GetBackEndPath() ' This function returns the BE folder path and filename
    ' Trim the filename
    bePath = Left(bePath, Len(bePath) - 29) ' 29 = len of BE filename:
    bePath = bePath & "\YourFolderName"  ' substitute your foldername
   
    If DCount("PathID", "tblPath", "Purpose = 'MedDocs'") > 0 Then
        ' a record exists for MedDocs
        sDocPath = DLookup("DefaultPath", "tblPath", "Purpose = 'MedDocs'")
        If sDocPath = bePath Then   'value is the default/expected
            ' do nothing
        Else
            ' set value for path to folder
            strSql = "UPDATE yourtablename " & _  ' substitute your table
            " SET DefaultPath = '" & bePath & "', ChangeBy = '" & setUser & "', Changedt = #" & SetDt & "#" & _
            " WHERE Purpose = 'MedDocs'"
        End If
    Else ' no record so create one
            strSql = "Insert into YourTableName (Purpose, DefaultPath, ChangeBy, ChangeDt)" & _
                    " Values ('MedDocs','" & bePath & "', '" & setUser & "' , #" & SetDt & "# )"
    End If

    If strSql <> "" Then
    '    Debug.Print strSQL
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSql
        DoCmd.SetWarnings True
        Me.Requery
    End If

    PID = Me.Parent.PersonID

    If PID & "" = "" Then   ' probably unnecessary as will not get to here without it
        MsgBox "A medical document cannot be stored if there is no person associated to the document. " & vbCrLf & _
            "Select the person the medical document relates to.", vbOKOnly, "Who is this medical document about?"
        GoTo subExit
    End If
    ' create a dedicated folder based on the name    
    sPersonName = DLookup("[FirstName]", "tblPeople", "[PersonID] = " & PID)
    sPersonName = sPersonName & DLookup("[LastName]", "tblPeople", "[PersonID] = " & PID)
    fStripIllegal (sPersonName)
    Call Mk_Dir(sPersonName, sDocPath)
    sDocPath = sDocPath & "\" & sPersonName & "\"
'    Debug.Print sDocPath
 
    sFile = FSBrowse("", msoFileDialogFilePicker, "All Files (*.*),*.*")
    If sFile <> "" Then
        sFolder = sDocPath
'    Debug.Print sFile
       
        'Ensure the Attachment folder exists
        If FolderExist(sFolder) = False Then MkDir (sFolder)
        'Copy the file to the Attachment folder
       
        If CopyFile(sFile, sFolder & GetFileName(sFile)) = True Then
            'Add this new path to db
            Me.txtDocLink = sFolder & GetFileName(sFile)
            Me.txtDocName = GetFileName(sFile)
        Else
            'Report the File Copy failed
            MsgBox "The process of copying the file failed", vbInformation, "OOPS!"
            GoTo subExit
        End If
    End If

End Sub

to get the BE file path:
Code:
Function GetBackEndPath() As String

Dim db              As DAO.Database
Dim tdf             As DAO.TableDef

    On Error GoTo ErrorHandler
   
    ' Loop through the TableDefs collection to find a linked table
    Set db = CurrentDb
    For Each tdf In db.TableDefs
        If Len(tdf.Connect) > 0 Then ' Check if the table is linked
            ' Extract the backend file path from the Connect property
            GetBackEndPath = Mid(tdf.Connect, InStr(1, tdf.Connect, "DATABASE=") + 9)
            Exit Function
        End If
    Next tdf
   
    ' If no linked table is found, return a message
    GetBackEndPath = "No linked backend file found."

FSBrowse -
'***** Requires a Reference to the 'Microsoft Office XX.X Object Library *****
'FSBrowse (File System Browse) allows the operator to browse for a file/folder.
' strStart specifies where the process should start the browser.
' lngType specifies the MsoFileDialogType to use.
' msoFileDialogOpen 1 Open dialog box.
' msoFileDialogSaveAs 2 Save As dialog box.
' msoFileDialogFilePicker 3 File picker dialog box.
' msoFileDialogFolderPicker 4 Folder picker dialog box.
' strPattern specifies which FileType(s) should be included.

Code:
Public Function FSBrowse(Optional strStart As String = "", _
                         Optional lngType As MsoFileDialogType = _
                         msoFileDialogFolderPicker, _
                         Optional strPattern As String = "All Files,*.*" _
                         ) As String
    Dim varEntry              As Variant
   
    Dim strModuleName   As String
    Dim strSubName      As String
   
    On Error GoTo ErrorHandler
   
    FSBrowse = ""
    With Application.FileDialog(DialogType:=lngType)
        'Set the title to match the type used from the list
        .Title = "Browse for "
        Select Case lngType
            Case msoFileDialogOpen
                .Title = .Title & "File to open"
            Case msoFileDialogSaveAs
                .Title = .Title & "File to SaveAs"
            Case msoFileDialogFilePicker
                .Title = .Title & "File"
            Case msoFileDialogFolderPicker
                .Title = .Title & "Folder"
        End Select
        If lngType <> msoFileDialogFolderPicker Then
            'Reset then add filter patterns separated by tildes (~) where
            '  multiple extensions are separated by semi-colons (;) and the
            '  description is separated from them by a comma (,).
            '  Example strPattern :
            '  "MS Access,*.ACCDB; *.MDB~MS Excel,*.XLSX; *.XLSM; *.XLS"
            Call .Filters.Clear
            For Each varEntry In Split(strPattern, "~")
                Call .Filters.Add(Description:=Split(varEntry, ",")(0), _
                                  Extensions:=Split(varEntry, ",")(1))
            Next varEntry
        End If
        'Set some default settings
        .InitialFileName = strStart
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        'Only return a value from the FileDialog if not cancelled.
        If .Show Then FSBrowse = .SelectedItems(1)
    End With
   
End Function

Some edits made - add your error handling ...

Given the other replies you can see a range of the actions needed.

To open/ execute a file:
Code:
Option Compare Database
Option Explicit

Private Const sModName = "modExternalFiles"

'Source: http://www.pacificdb.com.au/MVP/Code/ExeFile.htm
Public Const SW_HIDE = 0
Public Const SW_MINIMIZE = 6
Public Const SW_RESTORE = 9
Public Const SW_SHOW = 5
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOWNORMAL = 1

#If Win64 Then

Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                                     (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
                                      ByVal lpParameters As String, ByVal lpDirectory As String, _
                                      ByVal nShowCmd As Long) As LongPtr
                                    
#Else
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
#End If

Public Sub ExecuteFile(sFileName As String, sAction As String)
    
    Dim vReturn               As Long
    'sAction can be either "Open" or "Print".

    If ShellExecute(Access.hWndAccessApp, sAction, sFileName, vbNullString, "", SW_SHOWNORMAL) < 33 Then
        DoCmd.beep
        MsgBox "File not found."
    End If
    
End Sub
 
Hi, thanks for the answer/suggestion and sorry if i was confused. You are righ, in my explanation i forgot to say that, once i move the file, i should update the link (with the new one). Just to summarize:
1. I have a sub form (the source is a table with 2 fields: ID and LINKED_DOC (which is type hyperlink). The ID i use to refer to the record in my main form.
2. The user can add one or more document (as link)
The problem which i see (maybe is easily solved) is that if any user decides to link a file located in own disk "local" file (e.g. located in C: Drive) other users (which also use the same interface, I have BE separated) they may not open that file because is a "local" file. Now, i don't know if this can be avoided with your process or by using the GoHyperlink procedure (thank you, really very useful). I can also decide to not use "hyperlink" field, important for me to solve the "possible" issue.
Could be possible to have the script you use to:
- Select the file
- Collect the path
- Collect the file
- How to combine and show the clickable link that opens the file? (question: if the file is local? can be open anyway from anyone?)
Thanks again,
Cheers
 
Thank you all, really great solution and information.
Although all the solutions either gives me alternatives and/or lesson learns, the solution proposed by "arnelgp" solve 100% my problem, is exactly what i need. In this way I'm always sure that, even if someone use a file located in a "local" folder, the file will be moved to a dedicated network folder where everyone will have access, and the link is well updated in my table.
Thanks again.
Cheers

 
Hyperlink is one of the abomination data types that came to ACE with A2007. It is a two part field. It keeps a name in one part and the actual link in another. This data type cannot be upsized so if a RDBMS other than ACE is in your future, don't use any of the abomination data types.
if you really need the two parts, then use two fields. Once you store the hyperlink as plain text, you use the FollowHyperlink command to open the link.
 

Users who are viewing this thread

Back
Top Bottom