Solved Open folder link from Table (1 Viewer)

A

Alvein17

New member
Local time
Tomorrow, 01:59
Joined
Sep 2, 2021
Messages
29
Dear All,

Good day,

I want to open folder link from table database, but that link wouldn't open the folder.

first, i store the folder link in FileLocation Fields and i set datatype as Hyperlink. Please see the picture below.
1637661045255.png
1637661161409.png


actualy file location will store attachment data/file but i replace with folder link. here i attach my query:

DC = " INSERT INTO [Tb_Asset] ( Sapcode, Flexcode, Namaaset, Serialnumber, Tanggaldep, Qty, LOKASI, FileLocation) " _
& " SELECT [Forms]![frmNew]![txtSap] as Sapcode, [Forms]![frmNew]![txtflex] AS Flexcode, " _
& " [Forms]![frmNew]![txtnama] as Namaaset, [Forms]![frmNew]![txtsn] as Serialnumber, [forms]![frmnew]![txtdate] as Tanggaldep, " _
& " [Forms]![frmNew]![txtqty] as Qty, [Forms]![frmNew]![txtlokasi] as Lokasi, [Forms]![frmNew]![txtfileloc] as FileLocation "

DoCmd.RunSQL DC
MsgBox "Data sudah tersimpan", vbInformation, "INFO"
DoCmd.SetWarnings True

Me.txtFlex = ""
Me.txtsap = ""
Me.txtnama = ""
Me.txtsn = ""
Me.txtdate = ""
Me.txtqty = ""
Me.txtlokasi = ""
Me.txtfileloc = ""
Click to expand...

would you to guide me how to make it better?

thank you
 

Attachments

  • 1637661084172.png
    1637661084172.png
    38.3 KB · Views: 133
Ranman256

Ranman256

Well-known member
Local time
Today, 14:59
Joined
Apr 9, 2015
Messages
4,337
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.pdf, will open it in acrobat
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..

usage:
OpenNativeApp txtBox

paste this code into a module
Code: 
'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
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 02:59
Joined
May 7, 2009
Messages
19,245
you put your table/query in a form.
then you can add a button that will go to the "path"
Code: 
Private Sub button1_Click()
Dim strPath As String
strPath = Me![theHyperLinkTextbox]
strPath = getPath(Split(strPath, "#")(1))
If Len(strPath) = False Then
    strPath = Environ$("userprofile") & "\documents\"
End If
Application.FollowHyperlink strPath
End Sub


Public Function getPath(ByVal p As String)
Dim sPath As String
Dim i As Integer
i = InStrRev(p, "\")
sPath = Left$(p, i)
getPath = sPath
End Function
 
P

Pat Hartman

Super Moderator
Staff member
Local time
Today, 14:59
Joined
Feb 19, 2002
Messages
43,279
I would suggest using plain text rather than the hyperlink data type. Then in your code, use the FollowHyperlink method to open the file. FollowHyperlink will open any file whose type is defined to Windows.
 
A

Alvein17

New member
Local time
Tomorrow, 01:59
Joined
Sep 2, 2021
Messages
29
arnelgp said:
you put your table/query in a form.
then you can add a button that will go to the "path"
Code: 
Private Sub button1_Click()
Dim strPath As String
strPath = Me![theHyperLinkTextbox]
strPath = getPath(Split(strPath, "#")(1))
If Len(strPath) = False Then
    strPath = Environ$("userprofile") & "\documents\"
End If
Application.FollowHyperlink strPath
End Sub


Public Function getPath(ByVal p As String)
Dim sPath As String
Dim i As Integer
i = InStrRev(p, "\")
sPath = Left$(p, i)
getPath = sPath
End Function
Click to expand...
Dear Arnelgp,

i was try your guide but i found some error like this :
1637736783088.png


and in strPath i change [thehyperlinktextbox] with [txtfileloc] it's true? where i should put my table in form (input data or search)

heree i attach my form to input data and to search data.

input data:
1637737038932.png

search data:
1637737122455.png
 
A

Alvein17

New member
Local time
Tomorrow, 01:59
Joined
Sep 2, 2021
Messages
29
Pat Hartman said:
I would suggest using plain text rather than the hyperlink data type. Then in your code, use the FollowHyperlink method to open the file. FollowHyperlink will open any file whose type is defined to Windows.
Click to expand...
hello sir,

i would try your example. thank you sir
 
A

Alvein17

New member
Local time
Tomorrow, 01:59
Joined
Sep 2, 2021
Messages
29
Ranman256 said:
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.pdf, will open it in acrobat
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..

usage:
OpenNativeApp txtBox

paste this code into a module
Code: 
'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
Click to expand...
hello sir,

let me try first your example.

thank you
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 02:59
Joined
May 7, 2009
Messages
19,245
the code i gave you is for Hyperlink field.
since you change it to a Regular text, you need to change the sub.
Code: 
Private Sub button1_Click()
Dim strPath As String
strPath = Me![txtFileLocation] & ""
If Len(strPath) Then
    strPath = getPath(strPath)
Else
    strPath = Environ$("userprofile") & "\documents\"
End If
Application.FollowHyperlink strPath
End Sub


Public Function getPath(ByVal p As String)
Dim sPath As String
Dim i As Integer
i = InStrRev(p, "\")
sPath = Left$(p, i)
getPath = sPath
End Function
 
Last edited:
A

Alvein17

New member
Local time
Tomorrow, 01:59
Joined
Sep 2, 2021
Messages
29
arnelgp said:
the code i gave you is for Hyperlink field.
since you change it to a Regular text, you need to change the sub.
Code: 
Private Sub button1_Click()
Dim strPath As String
strPath = Me![txtFileLocation] & ""
If Len(strPath) Then
    strPath = getPath(strPath)
Else
    strPath = Environ$("userprofile") & "\documents\"
End If
Application.FollowHyperlink strPath
End Sub


Public Function getPath(ByVal p As String)
Dim sPath As String
Dim i As Integer
i = InStrRev(p, "\")
sPath = Left$(p, i)
getPath = sPath
End Function
Click to expand...
hey ArnelGp,

the code had you give for hyperlink it's work. and if, i want use regular text where i should change the part of sub?

thank you
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 02:59
Joined
May 7, 2009
Messages
19,245
code on post #3 is for Hyperlink, code on post #8 is for plain text.
 
A

Alvein17

New member
Local time
Tomorrow, 01:59
Joined
Sep 2, 2021
Messages
29
D
arnelgp said:
the code i gave you is for Hyperlink field.
since you change it to a Regular text, you need to change the sub.
Code: 
Private Sub button1_Click()
Dim strPath As String
strPath = Me![txtFileLocation] & ""
If Len(strPath) Then
    strPath = getPath(strPath)
Else
    strPath = Environ$("userprofile") & "\documents\"
End If
Application.FollowHyperlink strPath
End Sub


Public Function getPath(ByVal p As String)
Dim sPath As String
Dim i As Integer
i = InStrRev(p, "\")
sPath = Left$(p, i)
getPath = sPath
End Function
Click to expand...
 
You must log in or register to reply here.

Similar threads

L
Second instance of Word opened from Access arises security warning?
Replies
14
Views
680
lauro
L
DittoBird
Is There a Way to Copy a Linked Image to The Clipboard From a Form Linked Image Control?
2
Replies
30
Views
1,086
moke123
moke123
B
VBA problem relating to SQL linked table
Replies
6
Views
544
CJ_London
C
mike60smart
Choose a Folder
2
Replies
32
Views
1,585
jdraw
jdraw
smtazulislam
How to create Folder exist from TABLE and Syncing in Data Form
2
Replies
24
Views
1,493
smtazulislam
smtazulislam

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom