Pointing to Current folder path in VBA

[ReignEternal]

Hello,

I have a situation. I have a file (unfortunately I can't share this file as it is a proprietary file for my company but I can provide the associated VBA I am using) that in select cells based on the Manufacture and Model, it is creating hyperlinks to a folder then referencing the folder name and the sub file name.

I have 2 Public Const

Public Const dirSpec As String = "\\fs1\Public\MASTER\OPS\SUBMITTALS\"
Public Const dirOM As String = "\\fs1\Public\MASTER\OPS\Owners Manuals\"

The problem I am facing is these are moving to a per job basis and will no longer be "Constant" in the fact that the two above folder locations will no change for every job. See example 1 and 2

Example job 1
"\\fs1\Public\MASTER\JOB 1\SUBMITTALS\"
"\\fs1\Public\MASTER\JOB 1\Owners Manuals\"

"\\fs1\Public\MASTER\JOB 2\SUBMITTALS\"
"\\fs1\Public\MASTER\JOB 2\Owners Manuals\"

In the above examples, the text in bold is what will be changing

Instead of doing a Public Const, how can I fix this to point to the "Current Folder"?
"\\fs1\Public\MASTER\CURRENT FOLDER\SUBMITTALS\"
"\\fs1\Public\MASTER\CURRENT FOLDER\Owners Manuals\"

Sub fSpec(ByVal Target As Range, ByVal sDir As String, ByVal col As Integer, Optional ByVal bOpen As Boolean, Optional ByVal CopyPath As String)
       
    Dim sFolder As String
    Dim sPath As String
    Dim sFile(3) As String
   
    Dim sManf As String
    Dim sModel As String
    Dim r As Integer
   
    'Loop over each range of a non continuous range
    For Each rng In Target.Areas
       
    'Loop over each row in rng
    For r = 1 To rng.Rows.Count
   
    With rng.Rows(r).EntireRow
    If .Cells(1, colQtyCur).Value > 0 Then
        'Clear out unwanted characters
        sManf = Replace(.Cells(1, colManf).Text, "/", "")
        sManf = Replace(sManf, "\", "")
       
        sModel = Replace(.Cells(1, colModel), "/", "")
        sModel = Replace(sModel, "\", "")
               
        'See if we have a Manf and Model to work with
        If sManf <> "" And UCase(sManf) <> "Master" And sModel <> "" Then
               
            'Create the different possibilities
            sFolder = sManf & "\"
            sFile(1) = sManf & " - " & sModel & ".pdf"
            sFile(2) = sManf & "-" & sModel & ".pdf"
            sFile(3) = sManf & " " & sModel & ".pdf"
            sPath = ""
           
            'Test to see if one of the files exists
            For c = 1 To 3
             
              If FileOrDirExists(sDir & sFolder & sFile(c)) Then
                sPath = sDir & sFolder & sFile(c)
                sFile(0) = sFile(c)
                Exit For
              End If
             
            Next c
                   
            'If a spec sheet is found
            If sPath <> "" Then
                           
                'Create Hyperlink
                Call fHyperlink(.Cells(1, col + 1), sPath, "Link")
               
                'Mark Yes/No row to yes automaticly if we find a spec sheet
                If .Cells(1, col) = "" And (.Cells(1, colQtyCur) > 0) Then .Cells(1, col) = "Yes"
               
                'Open the spec sheet if specified in the call
                If bOpen Then ThisWorkbook.FollowHyperlink Address:=sPath, NewWindow:=True
               
                'Copy the spec sheet to a specific path if specified in the call
                If CopyPath <> "" And .Cells(1, col) = "Yes" Then
                    If Not FileOrDirExists(CopyPath & sFile(0)) Then FileCopy sPath, CopyPath & sFile(0)
                End If
             
            'Otherwise try to open the manf folder, or at least open the main folder
            ElseIf bOpen Then
               
                If FileOrDirExists(sDir & sFolder) Then
                    ThisWorkbook.FollowHyperlink Address:=sDir & sFolder, NewWindow:=True
               
                ElseIf FileOrDirExists(sDir) Then
                    Result = MsgBox("The folder '" & sFolder & "' does not exist.  " & vbCrLf & "Would you like to create it?", vbYesNo, "Create Folder?")
                   
                    If Result = vbYes Then
                        On Error Resume Next
                        MkDir (sDir & sFolder)
                        On Error GoTo 0
                        ThisWorkbook.FollowHyperlink Address:=sDir & sFolder, NewWindow:=True
                    End If
                   
                Else
                    MsgBox "The directory, " & sDir & ", does not exist.", vbCritical, "Directory does not exist!"
                End If
               
            End If
               
        End If
    End If
   
    End With
   
    If col = colSpec Then
        Application.StatusBar = "Specs: " & rng.Rows(r).Row - startline & " of " & rng.Rows.Count - startline
    ElseIf col = colOM Then
        Application.StatusBar = "O&&M: " & rng.Rows(r).Row - startline & " of " & rng.Rows.Count - startline
    End If
   
    DoEvents

    Next r
    Next rng

    Application.StatusBar = False

End Sub

 

[rlv01]

I have 2 Public Const

Public Const dirSpec As String = "\\fs1\Public\MASTER\OPS\SUBMITTALS\"
Public Const dirOM As String = "\\fs1\Public\MASTER\OPS\Owners Manuals\"

Instead of doing a Public Const, how can I fix this to point to the "Current Folder"?
"\\fs1\Public\MASTER\CURRENT FOLDER\SUBMITTALS\"
"\\fs1\Public\MASTER\CURRENT FOLDER\Owners Manuals\"

A lot depends on what you mean by "CURRENT FOLDER" . The defining information needs to come from somewhere. User input, spreadsheet cell, current HD directory. Something.

Sub Example()
    'Public Const dirSpec As String = "\\fs1\Public\MASTER\OPS\SUBMITTALS\"
    'Public Const dirOM As String = "\\fs1\Public\MASTER\OPS\Owners Manuals\"
    
    Dim dirSpec As String, dirOM As String
    Dim CurrentFolder As String
    
    CurrentFolder = ActiveSheet.Range("A1").Value 'get CurrentFolder from a cell value
    
    CurrentFolder = InputBox("Enter Folder Name", , "OPS") 'get CurrentFolder from user input
    
    If CurrentFolder <> "" Then
        dirSpec = "\\fs1\Public\MASTER\" & CurrentFolder & "\SUBMITTALS\"
        dirOM = "\\fs1\Public\MASTER\" & CurrentFolder & "\Owners Manuals\"
    End If
End Sub

 

[ReignEternal]

A lot depends on what you mean by "CURRENT FOLDER" . The defining information needs to come from somewhere. User input, spreadsheet cell, current HD directory. Something.

Sub Example()
    'Public Const dirSpec As String = "\\fs1\Public\MASTER\OPS\SUBMITTALS\"
    'Public Const dirOM As String = "\\fs1\Public\MASTER\OPS\Owners Manuals\"
   
    Dim dirSpec As String, dirOM As String
    Dim CurrentFolder As String
   
    CurrentFolder = ActiveSheet.Range("A1").Value 'get CurrentFolder from a cell value
   
    CurrentFolder = InputBox("Enter Folder Name", , "OPS") 'get CurrentFolder from user input
   
    If CurrentFolder <> "" Then
        dirSpec = "\\fs1\Public\MASTER\" & CurrentFolder & "\SUBMITTALS\"
        dirOM = "\\fs1\Public\MASTER\" & CurrentFolder & "\Owners Manuals\"
    End If
End Sub

So with your example, the user would have to advise of where the files are located when the document is opened the 1st time? Or would it be everytime the document is opened?

 

[rlv01]

It could be either - and whether it is one or the other depends on decisions you need to make.

        dirSpec = "\\fs1\Public\MASTER\" & CurrentFolder & "\SUBMITTALS\"
        dirOM = "\\fs1\Public\MASTER\" & CurrentFolder & "\Owners Manuals\"

CurrentFolder is the variable part of your folder definition. It is the part that will change when you shift (for example) from JOB1 to JOB2. But if you want the folders to change depending on what job your are working on then there has to be an information source for whether the variable CurrentFolder = Job1 or Job2 (or Job99) . That source could be the user typing the job name in each time they open the file, or just any time they want it to change. It could be from a cell that stored the last job name. It could be via a dozen other methods I could name if I really wanted to spend time compiling the list. The point is that you are the one who knows your application best, and so you should think about how when and how you want your workbook to change to a new job and new folders, and where the information about which new job to change to is going to come from.

 

[ReignEternal]

It could be either - and whether it is one or the other depends on decisions you need to make.

        dirSpec = "\\fs1\Public\MASTER\" & CurrentFolder & "\SUBMITTALS\"
        dirOM = "\\fs1\Public\MASTER\" & CurrentFolder & "\Owners Manuals\"

CurrentFolder is the variable part of your folder definition. It is the part that will change when you shift (for example) from JOB1 to JOB2. But if you want the folders to change depending on what job your are working on then there has to be an information source for whether the variable CurrentFolder = Job1 or Job2 (or Job99) . That source could be the user typing the job name in each time they open the file, or just any time they want it to change. It could be from a cell that stored the last job name. It could be via a dozen other methods I could name if I really wanted to spend time compiling the list. The point is that you are the one who knows your application best, and so you should think about how when and how you want your workbook to change to a new job and new folders, and where the information about which new job to change to is going to come from.

I see where the issue is going to popup. So our process is that we have a template folder that lives in "Master" , that template folder gets copied and pasted into the same "Master" location. The newly pasted folder then gets renamed to "Job XX". We currently don't have any cell in the file that generates or stores the job number. So it looks like it would have to be a manual entry to point to the "Specs" or "Manuals" file paths. But I tried your VBA and yes a popup takes place but I can't get anything to happen.

 

[rlv01]

"I can't get anything to happen" is an extremely vague statement.

'How to get user input and use it to validate job folders
Sub CodingExample2()
    Dim dirSpec As String, dirOM As String
    Dim JobName As String
    Dim dirSpecFound As Boolean, dirOMFound As Boolean
    
    JobName = InputBox("Enter job name", , "OPC") 'get desired job name from user input
    
    If JobName = "" Then
        MsgBox "User Cancel"
        Exit Sub
    End If
    
    '"\\fs1\Public\MASTER\OPS\SUBMITTALS\"
    dirSpec = "\\fs1\Public\MASTER\" & JobName & "\SUBMITTALS\"
    
    '"\\fs1\Public\MASTER\OPS\Owners Manuals\"
    dirOM = "\\fs1\Public\MASTER\" & JobName & "\Owners Manuals\"
    
    With CreateObject("Scripting.FileSystemObject")
        dirSpecFound = .FolderExists(dirSpec)
        dirOMFound = .FolderExists(dirOM)
    End With
    
    If Not (dirSpecFound And dirOMFound) Then
        If Not dirSpecFound Then
            MsgBox "The Submittals folder for job '" & JobName & "'does not exist:" & vbCrLf & vbCrLf _
            & dirSpec, vbOKOnly Or vbExclamation, Application.Name
        End If
        
        If Not dirOMFound Then
            MsgBox "The Manuals folder for job '" & JobName & "'does not exist:" & vbCrLf & vbCrLf _
            & dirOM, vbOKOnly Or vbExclamation, Application.Name
        End If
        Debug.Print dirSpec
        Debug.Print dirOM
        Exit Sub
    End If
    
    MsgBox "Success! Job folders exist"
    
    '
    ' Your code below
    '
 
End Sub

 

[ReignEternal]

"I can't get anything to happen" is an extremely vague statement.

'How to get user input and use it to validate job folders
Sub CodingExample2()
    Dim dirSpec As String, dirOM As String
    Dim JobName As String
    Dim dirSpecFound As Boolean, dirOMFound As Boolean
   
    JobName = InputBox("Enter job name", , "OPC") 'get desired job name from user input
   
    If JobName = "" Then
        MsgBox "User Cancel"
        Exit Sub
    End If
   
    '"\\fs1\Public\MASTER\OPS\SUBMITTALS\"
    dirSpec = "\\fs1\Public\MASTER\" & JobName & "\SUBMITTALS\"
   
    '"\\fs1\Public\MASTER\OPS\Owners Manuals\"
    dirOM = "\\fs1\Public\MASTER\" & JobName & "\Owners Manuals\"
   
    With CreateObject("Scripting.FileSystemObject")
        dirSpecFound = .FolderExists(dirSpec)
        dirOMFound = .FolderExists(dirOM)
    End With
   
    If Not (dirSpecFound And dirOMFound) Then
        If Not dirSpecFound Then
            MsgBox "The Submittals folder for job '" & JobName & "'does not exist:" & vbCrLf & vbCrLf _
            & dirSpec, vbOKOnly Or vbExclamation, Application.Name
        End If
       
        If Not dirOMFound Then
            MsgBox "The Manuals folder for job '" & JobName & "'does not exist:" & vbCrLf & vbCrLf _
            & dirOM, vbOKOnly Or vbExclamation, Application.Name
        End If
        Debug.Print dirSpec
        Debug.Print dirOM
        Exit Sub
    End If
   
    MsgBox "Success! Job folders exist"
   
    '
    ' Your code below
    '
 
End Sub

Sorry, "I can't get anything to happen" is very vague. I am traveling right now so when I have a chance, I will capture some screenshots of what I am experiencing.

 

[petertenthije]

Would this not be solved by using the fomula:

=INFO("directory")

It shows the path of the current file.


Edited to add VBA option:

Sub DirectoryName()
    dirSpec = Evaluate("=INFO(""directory"")")
End Sub

 

[rlv01]

Edited to add VBA option:

Sub DirectoryName()
    dirSpec = Evaluate("=INFO(""directory"")")
End Sub

I believe that shows the path of the current directory, which is not always the same as the path of the current file.