Hi,
You might try this. The following code will let you browse for a file. Right now it is only looking for access databases, but should be able to modify it to look for any document. Set the text box to store the file link as a hyperlink and it should work. I will need more time to test my thinking. If I get a chance to try I will post back with my findings.
Dave
Option Compare Database
Option Explicit
Private Type OPENFILENAME
lStructSize As Long
hwnd As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function GetOpenFileName _
Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName _
Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_SAVE = 0
Private Const OFN_OPEN = 1
Private Sub Button2_Click()
On Error GoTo ErrHandler
With Me.yourtextbox_in_which_to_save_link_to_file
.Value = DialogFile(1, _
"Please select an Access database...", _
vbNullString, _
"Access Databases (*.mda, *.mdb, *.mde)|*.mda;*.mde;*.mdb", _
CurDir(), _
vbNullString)
'If Len(.Value) Then
'Me.chkUserRoster.Enabled = fIsJet4DB(.Value)
'Call cmdExecute_Click
'End If
End With
ExitHere:
Exit Sub
ErrHandler:
With Err
MsgBox "Error: " & .Number & vbCrLf & .Description, _
vbCritical Or vbOKOnly, .Source
End With
Resume ExitHere
End Sub
Private Function DialogFile(wMode As Integer, szDialogTitle As String, szFileName As String, szFilter As String, szDefDir As String, szDefExt As String) As String
Dim x As Long, OFN As OPENFILENAME, szFile As String, szFileTitle As String
With OFN
.lStructSize = Len(OFN)
.hwnd = Me.hwnd
.lpstrTitle = szDialogTitle
.lpstrFile = szFileName & String$(250 - Len(szFileName), 0)
.nMaxFile = 255
.lpstrFileTitle = String$(255, 0)
.nMaxFileTitle = 255
.lpstrFilter = NullSepString(szFilter)
.nFilterIndex = 2
.lpstrInitialDir = szDefDir
.lpstrDefExt = szDefExt
If wMode = 1 Then
OFN.Flags = OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
x = GetOpenFileName(OFN)
Else
OFN.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_PATHMUSTEXIST
x = GetSaveFileName(OFN)
End If
If x <> 0 Then
If InStr(.lpstrFile, Chr$(0)) > 0 Then
szFile = Left$(.lpstrFile, InStr(.lpstrFile, Chr$(0)) - 1)
End If
DialogFile = szFile
Else
DialogFile = ""
End If
End With
End Function
Private Function fIsJet4DB(strMDB As String) As Boolean
On Error GoTo ErrHandler
Dim cnn As Object
Set cnn = CreateObject("ADODB.Connection"
With cnn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;" _
& "Data Source=" & strMDB & ";Mode=Share Deny None;"
.Open
fIsJet4DB = (cnn.Properties("Jet OLEDB:Engine Type"
= 5)
End With
ExitHere:
On Error Resume Next
cnn.Close
Set cnn = Nothing
Exit Function
ErrHandler:
With Err
MsgBox "Error Number: " & .Number & vbCrLf & .Description, _
vbCritical Or vbOKOnly, .Source
End With
Resume ExitHere
End Function
'Pass a "|" separated string and returns a Null separated string
Private Function NullSepString(ByVal CommaString As String) As String
Dim intInstr As Integer
Const vbBar = "|"
Do
intInstr = InStr(CommaString, vbBar)
If intInstr > 0 Then Mid$(CommaString, intInstr, 1) = vbNullChar
Loop While intInstr > 0
NullSepString = CommaString
End Function
