Folders and Directories 2

[kerenjamieson]

I have designed a contact details database where the client wishes to save files (CV's) in Microsoft Word and then in Access she wants to be able to click on the relevant cv and open Word to view. I know in VB you can have list boxes where you can choose which drive, then which folder and then the relevant folder within that ie c:/My Documents/Fred Smith/CV2002.

Is there anyway of setting the same thing up using Access 2000 or will I have to use VB as the Front End?

I'm pretty new to VB and as I've already designed most of the forms in Access I would prefer to continue in Access if at all possible.

Many thanks in advance for help.

Keren

 

[benwah]

Hi Keren

Did you end up solving this problem? If so how?

Cheers
wah

 

[nberryman]

Have you tried a Hyperlink?

Create a Hyperlink field and in form view right click and browse for the file.

When the user next click the field they will open the document

If it's more complex let me know

Neil Berryman
IT Trainer
neil_berryman@btopenworld.com

 

[benwah]

Hi Neil

It is a bit more complex than that.

What i want is the user to select a .doc letter that they have saved somewhere on the server and then a mail merge will be performed on it. At the moment they have to type in the actual file path into a text box, but i would like something a little more user friendly.

Cheers
wah

 

[nberryman]

OK try this

Copy all this code into a new module


Option Compare Database

'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = ""
End If
End Function

'*********** Code End *****************


Right, call the code from a command button on your form like this

Private Sub Command2_Click()

Dim strFolderName As String
strFolderName = BrowseFolder("What Folder you want to select?&quot
Me![RootFolder] = strFolderName & "\"

End Sub

This returns the folder name into a field called [Rootfolder]and adds a \ to it

You can use them by joining the rootfolder and filename field together


I have this working in a database if you want a copy e mail me and I will send it to you



Neil Berryman
IT Trainer
neil_berryman@btopenworld.com

 

[benwah]

Hi Neil

Thanks for that bit of code, I'm sure i will be finding uses for it in the future!

But it only returns the folder path and not the actual file name.... Is there a way the user can see the required file within the folder then the full path (including filename) be returned?

Cheers
Ben

 

[DonQuichote]

OK. You asked for it. Hope it works on access 2000 too (please let me know). It's an awful lot of code. Create a new Class module, name it "ClsFileChooser" and paste the following code in it:

Option Compare Database
Option Explicit

'Last update: 2001/08/21

Private Const SUCCESSFUL As Long = 0
Private Const ERRBASE As Long = -2147217370

Private Type accOfficegetFileNameInfo
    hwndOwner As Long
    strAppName As String * 255
    strDlgTitle As String * 255
    strOpenTitle As String * 255
    strFile As String * 4096
    strInitialDir As String * 255
    strFilter As String * 255
    lngFilterIndex As Long
    lngView As Long
    lngFlags As Long
End Type

Private typData As accOfficegetFileNameInfo
Private ysnFollowDirecory As Boolean

Private Declare Function accOfficegetFileName Lib "msaccess.exe" Alias "#56" (gfni As accOfficegetFileNameInfo, ByVal fOpen As Integer) As Long
'Internal function in MS-Access to show the fileopen dialog, with FTP locations and everything.

Public Function FLAGCONFIRMREPLACE() As Long
 FLAGCONFIRMREPLACE = 1
End Function

Public Function FLAGNOCHANGEDIR() As Long
 FLAGNOCHANGEDIR = 2
End Function

Public Function FLAGALLOWREADONLY() As Long
 FLAGALLOWREADONLY = 4
End Function

Public Function FLAGALLOWMULTISELECT() As Long
 FLAGALLOWMULTISELECT = 8
End Function

Public Function FLAGDIRECTORYONLY() As Long
 FLAGDIRECTORYONLY = &H20
End Function

Public Function FLAGINITIALIZEVIEW() As Long
 FLAGINITIALIZEVIEW = &H40
End Function

Public Function VIEWDETAILS() As Long
 VIEWDETAILS = 0
End Function

Public Function VIEWPREVIEW() As Long
 VIEWPREVIEW = 1
End Function

Public Function VIEWPROPERTIES() As Long
 VIEWPROPERTIES = 2
End Function

Public Function VIEWLIST() As Long
 VIEWLIST = 3
End Function

Private Sub Class_Initialize()
 Dim strApplicationTitle As String
 typData.hwndOwner = Application.hWndAccessApp
 On Error Resume Next
 strApplicationTitle = DBEngine(0)(0).Properties("appTitle")
 On Error GoTo 0
 If Len(strApplicationTitle) = 0 Then strApplicationTitle = "Unknown Application"
 setCaptions strApplicationTitle
 setDirectory pathOf(DBEngine(0)(0).name)
 setFilter "All files (*.*)"
 setFlags &H41, 3
 ysnFollowDirecory = True
End Sub

Public Function getDirectory() As String
 getDirectory = trimFixedString(typData.strInitialDir)
End Function

Public Function getFileName(Optional ByVal initialDirectory As String = "", Optional ByVal fileName As String = "", _
                            Optional ByVal DialogTitle As String = "Select file", Optional ByVal openButtonLabel As String = "&Select", _
                            Optional ByVal filter As String = "All files (*.*)", Optional ByVal filterIndex As Long = 0, _
                            Optional ByVal appName = "", Optional ByVal view As Long = 3, _
                            Optional ByVal flags As Long = &H41, Optional ByVal selectExisting As Boolean = True) As String
 Const SUCCESSFUL As Long = 0
 Dim gfni As accOfficegetFileNameInfo
 On Error Resume Next
 If appName = "" Then appName = DBEngine(0)(0).Properties("appTitle")
 With gfni
     .hwndOwner = Application.hWndAccessApp
     .strAppName = appName
     .strDlgTitle = DialogTitle
     .strOpenTitle = openButtonLabel
     .strFile = fileName
     .strInitialDir = initialDirectory
     .strFilter = filter
     .lngFilterIndex = filterIndex
     .lngView = view
     .lngFlags = flags
 End With
 If officegetFileName(gfni, selectExisting) = SUCCESSFUL Then
   getFileName = Trim(gfni.strFile)
 Else
   getFileName = ""
 End If
End Function

Public Function getFileNameForOpen(Optional ByVal fileName As String = "") As String
 On Error Resume Next
 If Len(fileName) > 0 Then typData.strFile = fileName
 If officegetFileName(typData, True) = SUCCESSFUL Then
   getFileNameForOpen = Trim(typData.strFile)
   If ysnFollowDirecory Then setDirectory pathOf(trimFixedString(typData.strFile))
 Else
   getFileNameForOpen = ""
 End If
End Function

Public Function getFileNameForSave(Optional ByVal fileName As String = "") As String
 On Error Resume Next
 If Len(fileName) > 0 Then typData.strFile = fileName
 If officegetFileName(typData, False) = SUCCESSFUL Then
   getFileNameForSave = Trim(typData.strFile)
   If ysnFollowDirecory Then setDirectory pathOf(trimFixedString(typData.strFile))
 Else
   getFileNameForSave = ""
 End If
End Function

Public Function getLastFile() As String
 getLastFile = trimFixedString(typData.strFile)
End Function

Private Function officegetFileName(gfni As accOfficegetFileNameInfo, ByVal fOpen As Integer) As Long
 Dim lng As Long
 With gfni
      .strAppName = RTrim$(.strAppName) & vbNullChar
      .strDlgTitle = RTrim$(.strDlgTitle) & vbNullChar
      .strOpenTitle = RTrim$(.strOpenTitle) & vbNullChar
      .strFile = RTrim$(.strFile) & vbNullChar
      .strInitialDir = RTrim$(.strInitialDir) & vbNullChar
      .strFilter = RTrim$(.strFilter) & vbNullChar
      SysCmd acSysCmdClearHelpTopic
      lng = accOfficegetFileName(gfni, fOpen)
      .strAppName = RTrim$(trimFixedString(.strAppName))
      .strDlgTitle = RTrim$(trimFixedString(.strDlgTitle))
      .strOpenTitle = RTrim$(trimFixedString(.strOpenTitle))
      .strFile = RTrim$(trimFixedString(.strFile))
      .strInitialDir = RTrim$(trimFixedString(.strInitialDir))
      .strFilter = RTrim$(trimFixedString(.strFilter))
 End With
 officegetFileName = lng
End Function

Private Function pathOf(ByVal path As String) As String
'Returns the path piece of a full filename
 While (VBA.Len(path) > 1) And (VBA.Right$(path, 1) <> &quot;\&quot;)
      path = VBA.Left$(path, VBA.Len(path) - 1)
 Wend
 pathOf = path
End Function

Public Sub setCaptions(ByVal strAppName As String, Optional ByVal strDlgTitle As String = &quot;Select a file&quot;, Optional ByVal strButtonCaption As String = &quot;&Ok&quot;)
 With typData
     .strAppName = strAppName
     .strDlgTitle = strDlgTitle
     .strOpenTitle = strButtonCaption
 End With
End Sub

Public Sub setDirectory(ByVal strDir As String)
 typData.strInitialDir = strDir
End Sub

Public Sub setFileName(ByVal strFile As String)
 typData.strFile = strFile
End Sub

Public Sub setFilter(ByVal strFilter As String, Optional ByVal lngFilterIndex As Long = 0)
 typData.strFilter = strFilter
 typData.lngFilterIndex = lngFilterIndex
End Sub

Public Sub setFlags(ByVal lngFlags As Long, Optional ByVal lngView As Long = 0)
 With typData
     .lngFlags = lngFlags
     .lngView = lngView
 End With
End Sub

Public Sub setFollowDirectory(ysnValue As Boolean)
 ysnFollowDirecory = ysnValue
End Sub

Public Sub setTextFilter(Optional ByVal lngFilterIndex As Long = 0)
 typData.strFilter = &quot;Text files (*.txt)|Ascii files (*.asc)|Data files (*.dat)|Comma Separated Values (*.csv)&quot;
 typData.lngFilterIndex = lngFilterIndex
End Sub

Private Function trimFixedString(strVal As String) As String ' Trim the end of a string, stopping at the first null character.
 Dim intPos As Integer
 intPos = VBA.InStr(strVal, vbNullChar)
 If intPos > 0 Then
   trimFixedString = VBA.Trim$(VBA.Left$(strVal, intPos - 1))
 Else
   trimFixedString = VBA.Trim$(strVal)
 End If
End Function

You now have a filechooser:

with new ClsFilechooser
    .setDirectory "C:\"

... any other things you want to set first ...

    strFilename=.getFileNameForOpen
end with

Good luck

 

[benwah]

Got it all working and Perfect! Thanks Neil and Don. You have both been very helpful, now i just have to sit down and try and understand how the code actually does it!

Thanks again
wah