MS Access change directory and relative paths issue

[High Noon Joe]

Hi I'm wondering if you guys can help me.
I'm working on a project where I have a Access DB in one directory and Excel workbooks in another like so:

.
..
Access_Folder
Excel_Folder

The problem is programmatically linking the worksheets in Access using VBA.
I have the code to link the spreadsheets when they are in the same folder as the Access DB but not when they are in a seperate folder.

To add to this, as this is a project that needs to be moved from place to place every now and again, the VBA code I have written so far is reliant on the directory naming to be relative paths...

I have looked into using ChDir but it resorts to the "My Documents" folder. Does anyone know how to get 'round this?

Here's my code:

Function link_to_Excel()
Dim strPath As String
strPath = CurrentProject.Path 'Directory Path
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
'Loop through the folder & build file list
strFile = Dir(strPath & "\*.xls")
While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir
Wend
'see if any files were found
If intFile = 0 Then
strPath = CurrentProject.Path
ChDir ".."
ChDir "Excel_Folder"
strFile = Dir & "\*.xls"
While strFile <> ""
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
If intFile = 0 Then
MsgBox "No files found"
Exit Function
End If
End If
'cycle through the list of files & link to Access
For intFile = 1 To UBound(strFileList)
DoCmd.TransferSpreadsheet acLink, , strFileList(intFile), strPath & strFileList(intFile), True
Next
MsgBox UBound(strFileList) & " files were linked"
End Function

 

[Pyro]

If your Access_folder and your Excel_folder will always reside in the same folder, and the name of your Excel_folder is not likely to change then you could use something like:

Public Function GetNewPath()
 
Dim strOldPath As String
Dim strFolder As String
Dim strNewPath As String
 
strOldPath = CurrentProject.Path
 
strFolder = Split(strOldPath, "\")(UBound(Split(strOldPath, "\")))
 
strNewPath = Replace(strOldPath, strFolder, "Excel_folder")
 
GetNewPath = strNewPath
 
End Function

Now your code would look like:

Function link_to_Excel()
Dim strPath As String
strPath = GetNewPath 'Directory Path
 
.....

Untested

 

[High Noon Joe]

Hey Pyro, thanks for that. Worked a treat!
You're a star!