relative pathways

[mamesbury]

I am teaching myself what i need to know as i go along but have become stuck with this problem.

I am using some code in the event prceedure along with a module i found to browse for a file name and insert it into a text box, the only trouble is that it puts the absolute path in and i want it to display the relative path

Private Sub Command422_Click()

Dim strFilter As String
Dim lngFlags As Long
strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
"*.MDA;*.MDB")
strFilter = ahtAddFilterItem(strFilter, "Jpeg Files (*.jpeg)", "*.JPEG")
strFilter = ahtAddFilterItem(strFilter, "Jpg Files (*.jpg)", "*.JPG")
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")



MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:=CurDir, _
Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Hello! Open Me!")

'txtImageName = ahtCommonFileOpenSave(InitialDir:="/images/")



' Since you passed in a variable for lngFlags,
' the function places the output flags value in the variable.
Debug.Print Hex(lngFlags)

Refresh


End Sub

This is the code in the event proceedure, i have it showing the path in a message box at the minute to see if i can get it right. any ideas

this is the module coding

' Out:
' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
' Give the dialog a caption title.
If IsMissing(InitialDir) Then InitialDir = CurDir
If IsMissing(Filter) Then Filter = ""
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(Flags) Then Flags = 0&
If IsMissing(DefaultExt) Then DefaultExt = ""
If IsMissing(FileName) Then FileName = ""
If IsMissing(DialogTitle) Then DialogTitle = ""
If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
If IsMissing(OpenFile) Then OpenFile = True
' Allocate string space for the returned strings.
strFileName = Left(FileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With OFN
.lStructSize = Len(OFN)
.hwndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
' Didn't think most people would want to deal with
' these options.
.hInstance = 0
'.strCustomFilter = ""
'.nMaxCustFilter = 0
.lpfnHook = 0
'New for NT 4.0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
' This will pass the desired data structure to the
' Windows API, which will in turn it uses to display
' the Open/Save As Dialog.
If OpenFile Then
fResult = aht_apiGetOpenFileName(OFN)
Else
fResult = aht_apiGetSaveFileName(OFN)
End If

' The function call filled in the strFileTitle member
' of the structure. You'll have to write special code
' to retrieve that if you're interested.
If fResult Then
' You might care to check the Flags member of the
' structure to get information about the chosen file.
' In this example, if you bothered to pass in a
' value for Flags, we'll fill it in with the outgoing
' Flags value.
If Not IsMissing(Flags) Then Flags = OFN.Flags
ahtCommonFileOpenSave = TrimNull(OFN.strFile)
Else
ahtCommonFileOpenSave = vbNullString
End If
End Function

Function ahtAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.

If IsMissing(varItem) Then varItem = "*.*"
ahtAddFilterItem = strFilter & _
strDescription & vbNullChar & _
varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function

Sorry for the long post but i don't know what to do. SOMEBODY HELP ME

Mark

 

[ghudson]

List an example of what it "is" returning and also list what you "want" it to return.

 

[mamesbury]

It is returning C:\folder1\folder2\folder3\folder4\filename.jpg

the database resides in folder 3 so i need it to return \folder4\filename.jpg

several of these databases are on the network and so it needs to be flexible, the reson it needs to be relative aswell is so i can move the database plus associated folder to another location without loosing the link

thanks

 

[modest]

Before I give you the answer, is the image file always going to be in a subfolder of the database folder?

 

[ghudson]

I would suggest that you use a generic sub directory name for the pictures and only store the file names. That way you could add a string with the correct Drive:\Directories\ and & add the file names.

Check out this link and see how the file names are parsed out of the absolute path...
Browse [Find a directory or file]

 

[ghudson]

I think I know where modest is going and the below will help you determine where the db is located...

Getting the path to the current database

For Access 2000/2002/2003...

'returns the database file name
CurrentProject.Name

'returns the database path
CurrentProject.Path

'returns the database path and the file name
CurrentProject.FullName

For Access 97...

'returns the database file name
Dir(CurrentDb.Name)

'returns the database path
Left(CurrentDb.Name,Len(CurrentDb.Name)-Len(Dir(CurrentDb.Name)))

'returns the database path and the file name
CurrentDb.Name

'returns the directory that Access [msaccess.exe] is installed in
(SysCmd(acSysCmdAccessDir))

 

[modest]

well I was just going to say this

    Dim strDbPath As String
    Dim intSlashLoc As Integer
    Dim strImage As String

    strDbPath = CurrentDb.Name
    intSlashLoc = InStrRev(strDbPath, "\", Len(strDbPath))
    strDbPath = Left$(strDbPath, intSlashLoc)
    strImage = Right$(strImage, Len(strImage) - Len(strDbPath))

That will work for any image in the db's path or higher. Forgive me if there's any errors's I just typed it on the fly.

It is similar to hudson's but instead of using the database name.. you can modify it to whatever folder-level name you want.

 

[modest]

Public Function GetFilePath(strFileName As String) As String
    Dim intCounter As Integer
      
    For intCounter = Len(strFileName) To 1 Step -1
        If Mid$(strFileName, intCounter, 1) = "\" Then
            Exit For
        End If
    Next intCounter
    
    GetFilePath = Left$(strFileName, intCounter)
End Function

Or even, here's a function that will get the path of a file name you send into it (such as currentdb.name as in my example above).

I just thought I might post this so that you can learn about For loops and the length of strings (maybe you'd want to count how many "\" are in a string in the future.. I dont know, but you could learn from this loop.

 

[mamesbury]

That has helped alot, i will try all this tonight. I appriciete the help alot.
Modest - yes the image file will be a folder situated next to the mdb file

 

[mamesbury]

Modest

Where would i put this code?

Dim strDbPath As String
Dim intSlashLoc As Integer
Dim strImage As String

strDbPath = CurrentDb.Name
intSlashLoc = InStrRev(strDbPath, "\", Len(strDbPath))
strDbPath = Left$(strDbPath, intSlashLoc)
strImage = Right$(strImage, Len(strImage) - Len(strDbPath))

i recognise it from other coding for the link from the path stored to the image with can be relative, you just have to type it into a txt box. the browser however cant return the relative value into the txt box.
from the code i posted before i think the trimnull= has something to do with it. Sorry to bother you guys again.

 

[modest]

Put it in a module (keep together):

Public Function RelativePath(strImage As String) As String

    If strImage = "" Then
        Exit Function
    End If

    Dim strDbPath As String
    Dim intSlashLoc As Integer
    Dim strImage As String

    strDbPath = CurrentDb.Name
    intSlashLoc = InStrRev(strDbPath, "\", Len(strDbPath))
    strDbPath = Left$(strDbPath, intSlashLoc)
    RelativePath = Right$(strImage, Len(strImage) - Len(strDbPath))
    
    RelativePath = TrimNull(RelativePath)

End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function

Give that a shot. See if it works.