how to reference a linked external workbook in vba when it's folder name changes

[dsheard2015]

Hello,

I have a main folder which consists of many student folders and 1 Admin folder and this folder is moved to various locations on the network as needed. The student folders are originally named 1, 2, 3.... but when the class starts the folder names may be changed. Usually, the names match the names of each student but there is no pattern to what the instructor will use when renaming the folders. Admin will always remain the same. The workbooks within the student folders are all linked to the Admin workbook.

The example code below is located within the Admin workbook and is used to access the student workbook "1.xlsb", then finds the worksheet "AQC-Task Completion", then prints the range "A1:C41", and then returns back(Activates) to the Admin workbook.

The code works great as long as each student folder name remains 1, 2, 3.... but once the names are changed an error message pops up saying "the file can't be found..." which makes sense because the name was changed.

I have tried numerous things but can't seem to figure out how to get the name "1.xlsb" within the code to change dynamically when the folder name changes.

All help is greatly appreciated!

Dave

Sub print_aqc_a_1_admin()


Dim WB As Workbook
On Error Resume Next
Set WB = Workbooks("[COLOR=#ff0000]1.xlsb[/COLOR]")
On Error GoTo 0


If WB Is Nothing Then
    Set WB = Workbooks.Open(ThisWorkbook.Path & "\[COLOR=#ff0000]1.xlsb[/COLOR]")
    Worksheets("AQC-Task Completion").Range("A1:C41").PrintOut
    Application.Workbooks("ADMIN.xlsb").Activate
    Else
        Application.Workbooks("[COLOR=#ff0000]1.xlsb[/COLOR]").Activate
        Worksheets("AQC-Task Completion").Range("A1:C41").PrintOut
        Application.Workbooks("ADMIN.xlsb").Activate
End If


End Sub

 

[nemmi69]

You could try having fixed unique files in each of the directories. Then you could search for the files and record their location.

 

[dsheard2015]

nemmi69,

Thanks for your response but unless I am not understanding exactly what you mean, I don't think that will work. The "directory" as you call it would have had it's name changed and therefore the Admin file would not be able to locate it in order to get to the fixed file. Am I not understanding you correctly?

Thanks again

 

[nemmi69]

nemmi69,

Thanks for your response but unless I am not understanding exactly what you mean, I don't think that will work. The "directory" as you call it would have had it's name changed and therefore the Admin file would not be able to locate it in order to get to the fixed file. Am I not understanding you correctly?

Thanks again

The idea is to have a unique file in the directory so that even if the name of the directory changes you can do a top down search.

Something like this can do the search

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long


Private Type OPENFILENAME
    lStructSize       As Long
    hwndOwner         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

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Note: GetDirName() Get the directory of a specific file
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Function GetDirName(File2Fnd1 As String)
'For this to work a file needs to be selected. So the idea is to get the user
' to find and select a specific target file that the program will use in this
' directory. Thus doing 2 things at once -
' 1) since the file has been located it confirms the file exists
' 2) allows setting of a valid directory to this file
' ## This uses Windows equivalent of GetOpenFilename ##


Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim strFilter As String




Dim FullFileName As String
Dim FileName As String
Dim DirName As String
Dim FileOK As Boolean
Dim GetFileName As String
Dim TmpFullName As String
Dim GetFileExt As String
Dim CharFnd As Boolean


If File2Fnd1 = "" Then
    MsgBox "No target file supplied.", vbCritical, ThisWorkbook.Name
    Exit Function
End If


lReturn = 0
CharFnd = False
FileOK = False
    For CharNo = Len(File2Fnd1) To 1 Step -1
        If Mid(File2Fnd1, CharNo, 1) = "." Then
            GetFileExt = Right(File2Fnd1, Len(File2Fnd1) - CharNo + 1)
            GetFileName = Left(File2Fnd1, CharNo - 1)
            CharFnd = True
            Exit For
        End If
    Next CharNo
If CharFnd = False Then GetFileExt = "*.*"


strFilter = "Target File (*" & GetFileName & GetFileExt & ")" & Chr(0) & "*" & GetFileName & GetFileExt & Chr(0)


While FileOK = False
    OpenFile.lStructSize = Len(OpenFile)


    With OpenFile
        .lpstrFilter = strFilter
        .nFilterIndex = 1
        .lpstrFile = String(257, 0)
        .nMaxFile = Len(.lpstrFile) - 1
        .lpstrFileTitle = .lpstrFile
        .nMaxFileTitle = .nMaxFile
        .lpstrInitialDir = "C:\ADT\" 'sets starting directory
        .lpstrTitle = ThisWorkbook.Name & " - Set Directory for Target File (" & GetFileName & GetFileExt & ")"
        .flags = 0
    End With


    lReturn = GetOpenFileName(OpenFile)
    TmpFullName = ""
    If lReturn = 0 Then
        MsgBox "User cancelled.", vbCritical, ThisWorkbook.Name
        GetDirName = "UC"
        FileOK = True
    Else
        FullFileName = Trim(OpenFile.lpstrFile)
        'extract full filename string dropping non-characters
        For CharNo = 1 To Len(FullFileName)
            If Asc(Mid(FullFileName, CharNo, 1)) >= 32 And Asc(Mid(FullFileName, CharNo, 1)) <= 126 Then
                TmpFullName = TmpFullName & Mid(FullFileName, CharNo, 1)
            Else
                FullFileName = TmpFullName
                Exit For
            End If
        Next CharNo
        'seperate out filename and directory
        If FullFileName <> "" Then 'full file name is directory and filename
            For CharNo = Len(FullFileName) To 1 Step -1
                If Mid(FullFileName, CharNo, 1) = "\" Then
                    FileName = Right(FullFileName, Len(FullFileName) - CharNo) 'filename only
                    DirName = Left(FullFileName, Len(FullFileName) - Len(FileName)) 'directory
                    Exit For
                End If
            Next CharNo
        End If
    End If


    If FileOK = False Then
        'Check target file was selected
        If FileName = File2Fnd1 Then
            GetDirName = DirName
            FileOK = True
        Else
            MsgBox "The target file '" & File2Fnd1 & "' needs to be selected to set location.", vbCritical, ThisWorkbook.Name
        End If
    End If


Wend


Exit Function


End Function

Sub TryGetDirFun()
Dim File2Fnd As String
Dim FileDir As String
Dim Aloop As Integer


On Error GoTo ErrorReset
WsName1.Select
On Error GoTo 0


LoadOK = False
Worksheets(WsName1.Name).Range("B1:B3").Clear


For Aloop = 1 To 3
    FileDir = ""
    File2Fnd = "UniqueFilename.abc"
    
    FileDir = GetDirName(File2Fnd)
    If FileDir = "UC" Then
        'MsgBox "The relevant file '" & File2Fnd & "' was not selected.", vbCritical, ThisWorkbook.Name
    Else
        Worksheets(WsName1.Name).Range("B" & Aloop).Value = FileDir
    End If
Next Aloop
    


Exit Sub


ErrorCheck:


'Reset the application to its normal operating environment.
Application.StatusBar = False
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox ErrMsg, vbCritical, WbName.Name
Exit Sub


ErrorReset:
PrimeProgram
Resume




End Sub