populate hyperlink field with folder location using a button

[freemansurv]

Hello, I've searched the existing forums but unfortunatly can't find the answer. My VBA skills are limited but vaguly functional.

My question is as follows:

I have a form (Form_1) linked to a table (Table_1)


On the table (and form) is a field of type hyperlink. The field is called (Project_Folder)
Next to the field is a button (Button_1)

I want to be able to click the botton, browse to a folder on my hardrive, and then add that folder address to the field (Project_Folder), so that in the future when viewing the form I can either hyperlink to the folder assigned to field (Project_Folder), or edit and replace the link by clicking (Button_1).

Any help would be enormously appreciated.

[moke123]

I want to be able to click the botton, browse to a folder on my hardrive

To browse to a folder you need to use filedialog in a procedure like below.
You need a reference to microsoft office XXX object library.

Function msoBrowse(PickType As MsoFileDialogType, Optional StartFolder As String = "", Optional strTitle As String = "") As String


    On Error GoTo msoBrowse_Error


    Dim mso As Object
    Dim varFile As Variant


    If Nz(strTitle, "") = "" Then
    
        Select Case PickType
        
        Case 3
            strTitle = "Select a File"
        Case 4
            strTitle = "Select a Folder"
        Case Else
            strTitle = ""
            
        End Select
        
    End If


    Set mso = Application.FileDialog(PickType)


    With mso


        .Title = strTitle
        .AllowMultiSelect = False
        .InitialFileName = StartFolder


        If .Show = True Then


            If .SelectedItems.Count = 0 Then


                msoBrowse = ""
            End If


            For Each varFile In .SelectedItems
                msoBrowse = varFile
            Next


        Else


            msoBrowse = ""


        End If


    End With




    On Error GoTo 0
    Exit Function


msoBrowse_Error:


    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure msoBrowse, line " & Erl & "."


End Function

I would avoid using a hyperlink datatype and use a text datatype. you can always format it to look like a hyperlink and text is easier to work with.
To open the folder with code you would use application.followhyperlink.

[ranman256]

dont use a hyperlink effect. instead, use this:

Paste this code into a module, and it will open ANY file in its native application.
In a form put the field and a button to open it.

if the file is web address, will open it in a browser
if the file is myFile.doc, it will open the doc in Word
if its just a file path, it will open in file explorer.
etc..

button to open the folder usage:
OpenNativeApp txtBox


paste this code into a module

'Attribute VB_Name = "modNativeApp"
'Option Compare Database
Option Explicit


#If VBA7 Then
  Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As LongPtr
  Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
#Else
  Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
  Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If


Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&


Public Sub OpenNativeApp(ByVal psDocName As String)
Dim r As Long, msg As String

r = StartDoc(psDocName)
If r <= 32 Then
    'There was an error
    Select Case r
        Case SE_ERR_FNF
            msg = "File not found"
        Case SE_ERR_PNF
            msg = "Path not found"
        Case SE_ERR_ACCESSDENIED
            msg = "Access denied"
        Case SE_ERR_OOM
            msg = "Out of memory"
        Case SE_ERR_DLLNOTFOUND
            msg = "DLL not found"
        Case SE_ERR_SHARE
            msg = "A sharing violation occurred"
        Case SE_ERR_ASSOCINCOMPLETE
            msg = "Incomplete or invalid file association"
        Case SE_ERR_DDETIMEOUT
            msg = "DDE Time out"
        Case SE_ERR_DDEFAIL
            msg = "DDE transaction failed"
        Case SE_ERR_DDEBUSY
            msg = "DDE busy"
        Case SE_ERR_NOASSOC
            msg = "No association for file extension"
        Case ERROR_BAD_FORMAT
            msg = "Invalid EXE file or error in EXE image"
        Case Else
            msg = "Unknown error"
    End Select
'    MsgBox msg
End If
End Sub




Private Function StartDoc(psDocName As String) As Long
Dim Scr_hDC As Long


Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", psDocName, "", "C:\", SW_SHOWNORMAL)
End Function

usage:

sub btnOpenFile_click()
  OpenNativeApp ME.txtBox
end sub

button for user to select a folder/file,
usage:

vFile = UserPick1File("c:\folder")
if vFile <> "" then 
 i = InStrRev(vFile, "\")
 If i > 0 Then 
  txtBox = Left$(vFile, i)
 else
  exit sub
 endif
endif

pick a folder code, user must enter a 'file', or pick a file to get the folder.

Public Function UserPick1File(pvPath)
Dim strTable As String
Dim strFilePath As String
Dim sDialog As String, sDecr  As String, sExt As String
CONST msoFileDialogFilePicker = 3
CONST msoFileDialogViewList = 1

If IsMissing(pvPath) Then pvPath = "c:\"

With Application.FileDialog(msoFileDialogFilePicker)   'MUST ADD REFERENCE : Microsoft Office 11.0 Object Library
    .AllowMultiSelect = False
    .Title = "Locate a file to Import"
    .ButtonName = "Import"
    .Filters.Clear


    '.Filters.Add "Excel Files", "*.xlsx"
    .Filters.Add "Text Files", "*.csv"
    .Filters.Add "All Files", "*.*"
    .InitialFileName = pvPath
    .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail


        If .show = 0 Then
           'There is a problem
           Exit Function
        End If

    'Save the first file selected
    UserPick1File = Trim(.SelectedItems(1))
End With
End Function

[freemansurv]

Thanks, appreciate the time it took you to write that reply. However I don't want to open a file, I want to navigate to a folder and then save that folder location to a field on my form. I agee, using a text field rather than a hyperlink field is more sensible and I have made the changes.
Pasting code into modeules is kind of meaninless to me, I would like the code to execute upon pressing a button. Sorry for being a dim.

[moke123]

Here's an example.

[freemansurv]

Here's an example.

Hmm.

I've copied the code and objects seemingly exactly into my database,

When I click 'get folder path', I get variable not defined

Function msoBrowse(PickType As MsoFileDialogType, Optional StartFolder As String = "", Optional strTitle As String = "") As String

[Micron]

Have you set a reference to your version of Office? I believe you need that for the picker to work.

[freemansurv]

Have you set a reference to your version of Office? I believe you need that for the picker to work.

I don't know what this means, or how to go about doing it. I will do the right thing and google it.

[freemansurv]

Have you set a reference to your version of Office? I believe you need that for the picker to work.

I have updated the references, I am now getting an error "compile error - argument not optional"
strPath = msoBrowse()

No idea what is wrong, the code is identical to the working example!!

[Welshgasman]

I have updated the references, I am now getting an error "compile error - argument not optional"
strPath = msoBrowse()

No idea what is wrong, the code is identical to the working example!!

Well that cannot be the case can it.?

The msoBrowse() function requires at least one parameter PickType to identify what you are looking for?

So look at what Moke123 actually wrote to call it and supply the correct PickType

FWIW he chose msoFileDialogFolderPicker

[moke123]

As Gasman points out, you cant leave out the argument.

strPath = msoBrowse(msoFileDialogFolderPicker)

Just so you know, the same function can be used to pick a file. you just use a different argument.

msoBrowse (msoFileDialogFilePicker)

The first example is a folder picker and the second example is a file picker.
As micron pointed out and I stated in my first post it requires a reference to ms office object library.

[Micron]

the first argument is not Optional. That's what the message is saying - 'a required argument was not provided'
OOPS too late.