Open folder with partial name

N

nathank2

New Member
Joined
Aug 7, 2017
Messages
5
Hello! I just joined so I apologize in advance for any posting mistakes. Anyways, I want to search through a folder for a subfolder that contains a number input by the user. The subfolder name will have the format Projectnumber_TestNumber where the project number is always 8 characters and the test number is input by the user (ex. "12345678_TT12122"). Once the folder is located, I want to open a specific file in the folder (ex. "111.xlsx"). The issue is that the project number changes depending on the test and is not needed in the search so I tried to use a wildcard but cant seem to figure it out. I also tried the InStr function in another macro but cant figure that out either. Im new to VBA and need help! Hope this makes sense.


Its a ways from being done, but here is the code I have so far...

Code: 
Sub Macro3()

Dim FileName As String
Dim fPath As String


TestNum = InputBox("Please Input Test Number")


fPath = Dir("C:\Users\nathan\Documents\SD Improvements\SD Examples\*" & TestNum & "111.xlsx")
If fPath <> "" Then
    Workbooks.Open FileName:=fPath
End If


End Sub
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Sort by date Sort by votes
This is quite tricky for someone new to VBA as it involves a Dir loop, vbDirectory and the GetAttr function. Using your example, I have assumed that the user inputs the test number as "12122", not "TT12122".

Code: 
Public Sub Open_Workbook_In_Project_Folder()

    Dim TestNum As String
    Dim basePath As String, fileName As String
    Dim projectFolder As String
    
    TestNum = InputBox("Please input Test Number")
    If TestNum = "" Then Exit Sub
    
    basePath = "C:\Users\nathan\Documents\SD Improvements\SD Examples\"
    
    If Right(basePath, 1) <> "\" Then basePath = basePath & "\"
    
    projectFolder = ""
    fileName = Dir(basePath, vbDirectory)
    While fileName <> vbNullString And projectFolder = ""
        If (GetAttr(basePath & fileName) And vbDirectory) = vbDirectory Then
            If fileName Like "########_TT" & TestNum Then projectFolder = basePath & fileName & "\"
        End If
        fileName = Dir
    Wend
    
    If projectFolder <> "" Then
    
        Workbooks.Open projectFolder & "111.xlsx"
        
    Else
    
        MsgBox "Project folder for Test Number " & TestNum & " not found in " & basePath
        
    End If
        
End Sub
 
Upvote 0
I changed the "########_TT" to "*" so that the user can still input TT or something else if needed. Other than that the code works great! Thank you so much!!
 
Upvote 0
I modified the code and it stopped working. I need the code to open specific files within the folder that I search for based on the Test number. I want all of the break in, wet, and dry variables correspond to those files.Yes it is much longer but most of the stuff I have added in is very simple. Copying, pasting, and formatting. Also, each Spec sub is basically exactly the same as Spec1 except the selection is pasted in a different spot.





Code: 
Sub Import_Data()


' Imports .csv files that have been exported from VBOX Test Suite
' Requires knowledge of Test Number (Ex. TT18188)
' Requires .csv files with the naming convention ->  test code_spec_test method_test type_# in series
'
' test code = 111,115,117, etc.
' spec = D1892M, D1867M, etc.
' test method = Breakin, wet, or dry
' test type = Speed or Trigger (111 uses speed and trigger combination, all others are trigger)
'
'   Example for 111:   111_D1896M_Breakin_Speed_1.csv
'   Example for 115:   115_D1896M_Breakin_Trigger_1.csv




Dim TestNum As String
Dim basePath As String, fileName As String
Dim projectFolder As String
Dim Breakin1, Breakin1T, Breakin2, Breakin2T, Breakin3, Breakin3T, Breakin4, Breakin4T, Breakin5, Breakin5T, Breakin6, Breakin6T As String
Dim Wet1, Wet1T, Wet2, Wet2T, Wet3, Wet3T, Wet4, Wet4T, Wet5, Wet5T, Wet6, Wet6T As String
Dim Dry1, Dry1T, Dry2, Dry2T, Dry3, Dry3T, Dry4, Dry4T, Dry5, Dry5T, Dry6, Dry6T As String
    
    
    
'User inputs test number
TestNum = InputBox("Please input Test Number")
If TestNum = "" Then Exit Sub


'Base folder path for stopping distance .csv export files
basePath = "C:\Users\nathan\Documents\SD Improvements\SD Examples\"
    
If Right(basePath, 1) <> "\" Then basePath = basePath & "\"
    
'Finds folder within Base folder path from test number input
    projectFolder = ""
    fileName = Dir(basePath, vbDirectory)
    While fileName <> vbNullString And projectFolder = ""
        If (GetAttr(basePath & fileName) And vbDirectory) = vbDirectory Then
            If fileName Like "*" & TestNum Then projectFolder = basePath & fileName & "\"
        End If
        fileName = Dir
Wend
    
If projectFolder <> "" Then


        Call Spec1
        Call Spec2
        Call Spec3
        Call Spec4
        Call Spec5
        Call Spec6
         
End If
End Sub




Sub Spec1()


Dim TestNum As String
Dim basePath As String, fileName As String
Dim projectFolder As String
Dim Breakin1, Breakin1T As String
Dim Wet1, Wet1T As String
Dim Dry1, Dry1T As String




    Breakin1 = Dir(projectFolder & "*Breakin_Speed_1.csv")
    Breakin1T = Dir(projectFolder & "*Breakin_Trigger_1.csv")
    Wet1 = Dir(projectFolder & "*Wet_Speed_1.csv")
    Wet1T = Dir(projectFolder & "*Wet_Trigger_1.csv")
    Dry1 = Dir(projectFolder & "*Dry_Speed_1.csv")
    Dry1T = Dir(projectFolder & "*Dry_Trigger_1.csv")






If Breakin1T <> "" Then
        
        'For 111 test code - Break in
        If InStr(Breakin1T, "111") <> 0 Then
        
        'Hides sheets that arent used for 111 test code
        Sheets("Results").Visible = True
        Sheets("Results ").Visible = False
        Sheets("111 Raw Data").Visible = True
        Sheets("Raw Data").Visible = False
    
        'Opens Breakin speed file and pastes into universal template
        
            Workbooks.Open fileName:=Breakin1
            ActiveSheet.UsedRange.Copy
            Windows("Universal SD Template.xlsm").Activate
            Sheets("111 Raw Data").Select
            Range("B3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Range("B2").Value = Breakin1
            Range("B2").Select
            Selection.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1)), TrailingMinusNumbers:=True
            Range("B3").Select
            Selection.TextToColumns Destination:=Range("B3"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(22, 1)), TrailingMinusNumbers _
            :=True
            Workbooks.Open fileName:=Breakin1
            ActiveWindow.Close False
        
        'Opens Breakin trigger file and pastes into universal report
        
            Workbooks.Open fileName:=Breakin1T
            ActiveSheet.UsedRange.Copy
            Windows("Universal SD Template.xlsm").Activate
            Sheets("111 Raw Data").Select
            Range("K3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Range("K2").Value = Breakin1T
            Range("K2").Select
            Selection.TextToColumns Destination:=Range("K2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1)), TrailingMinusNumbers:=True
            Range("K3").Select
            Selection.TextToColumns Destination:=Range("K3"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(22, 1)), TrailingMinusNumbers _
            :=True
            Workbooks.Open fileName:=Breakin1T
            ActiveWindow.Close False
        End If
        Else


    'For test codes other than 111 - Break in
    If InStr(Breakin1T, "115") <> 0 Then
    
        Sheets("Results").Visible = False
        Sheets("Results ").Visible = True
        Sheets("111 Raw Data").Visible = False
        Sheets("Raw Data").Visible = True
        
    
            Workbooks.Open fileName:=Breakin1T
            ActiveSheet.UsedRange.Copy
            Windows("Universal SD Template.xlsm").Activate
            Sheets("Raw Data").Select
            Range("B3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Range("B2").Value = Breakin1T
            Range("B2").Select
            Selection.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1)), TrailingMinusNumbers:=True
            Range("B3").Select
            Selection.TextToColumns Destination:=Range("B3"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(22, 1)), TrailingMinusNumbers _
            :=True
            Workbooks.Open fileName:=Breakin1T
            ActiveWindow.Close False
        
    End If


End If


If Wet1T <> "" Then


    'For 111 test code - Wet
    If InStr(Wet1, "111") <> 0 Then
    
        'Hides sheets that arent used for 111 test code
        Sheets("Results").Visible = True
        Sheets("Results ").Visible = False
        Sheets("111 Raw Data").Visible = True
        Sheets("Raw Data").Visible = False
    
        'Opens Wet speed file and pastes into universal template
        
            Workbooks.Open fileName:=Wet1
            ActiveSheet.UsedRange.Copy
            Windows("Universal SD Template.xlsm").Activate
            Sheets("111 Raw Data").Select
            Range("T3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Range("T2").Value = Wet1
            Range("T2").Select
            Selection.TextToColumns Destination:=Range("T2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1)), TrailingMinusNumbers:=True
            Range("T3").Select
            Selection.TextToColumns Destination:=Range("T3"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(22, 1)), TrailingMinusNumbers _
            :=True
            Workbooks.Open fileName:=Wet1
            ActiveWindow.Close False
        
        
        'Opens Breakin trigger file and pastes into universal report
        
            Workbooks.Open fileName:=Wet1T
            ActiveSheet.UsedRange.Copy
            Windows("Universal SD Template.xlsm").Activate
            Sheets("111 Raw Data").Select
            Range("AC3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Range("AC2").Value = Wet1T
            Range("AC2").Select
            Selection.TextToColumns Destination:=Range("AC2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1)), TrailingMinusNumbers:=True
            Range("AC3").Select
            Selection.TextToColumns Destination:=Range("AC3"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(22, 1)), TrailingMinusNumbers _
            :=True
            Workbooks.Open fileName:=Wet1T
            ActiveWindow.Close False
        End If
    Else
    'For test codes other than 111
    If InStr(Wet1T, "115") <> 0 Then


        Sheets("Results").Visible = False
        Sheets("Results ").Visible = True
        Sheets("111 Raw Data").Visible = False
        Sheets("Raw Data").Visible = True
        


            Workbooks.Open fileName:=Wet1T
            ActiveSheet.UsedRange.Copy
            Windows("Universal SD Template.xlsm").Activate
            Sheets("111 Raw Data").Select
            Range("K3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Range("K2").Value = Wet1T
            Range("K2").Select
            Selection.TextToColumns Destination:=Range("K2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1)), TrailingMinusNumbers:=True
            Range("K3").Select
            Selection.TextToColumns Destination:=Range("K3"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(22, 1)), TrailingMinusNumbers _
            :=True
            Workbooks.Open fileName:=Wet1T
            ActiveWindow.Close False
        
    End If
End If






If Dry1T <> "" Then






    'For 111 test code - Dry
    If InStr(Dry1, "111") <> 0 Then
    
        'Hides sheets that arent used for 111 test code
        Sheets("Results").Visible = True
        Sheets("Results ").Visible = False
        Sheets("111 Raw Data").Visible = True
        Sheets("Raw Data").Visible = False
    
        'Opens Wet speed file and pastes into universal template
        
            Workbooks.Open fileName:=Dry1
            ActiveSheet.UsedRange.Copy
            Windows("Universal SD Template.xlsm").Activate
            Sheets("111 Raw Data").Select
            Range("AL3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Range("AL2").Value = Dry1
            Range("AL2").Select
            Selection.TextToColumns Destination:=Range("AL2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1)), TrailingMinusNumbers:=True
            Range("AL3").Select
            Selection.TextToColumns Destination:=Range("AL3"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(22, 1)), TrailingMinusNumbers _
            :=True
            Workbooks.Open fileName:=Dry1
            ActiveWindow.Close False
    
        
        'Opens Breakin trigger file and pastes into universal report
        


            Workbooks.Open fileName:=Dry1T
            ActiveSheet.UsedRange.Copy
            Windows("Universal SD Template.xlsm").Activate
            Sheets("111 Raw Data").Select
            Range("AL3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Range("AL2").Value = Dry1T
            Range("AL2").Select
            Selection.TextToColumns Destination:=Range("AL2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1)), TrailingMinusNumbers:=True
            Range("AL3").Select
            Selection.TextToColumns Destination:=Range("AL3"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(22, 1)), TrailingMinusNumbers _
            :=True
            Workbooks.Open fileName:=Dry1T
            ActiveWindow.Close False
        
    End If
    Else
    
    'For test codes other than 111
    If InStr(Dry1T, "115") <> 0 Then
    
        Sheets("Results").Visible = False
        Sheets("Results ").Visible = True
        Sheets("111 Raw Data").Visible = False
        Sheets("Raw Data").Visible = True
        
            Workbooks.Open fileName:=Dry1T
            ActiveSheet.UsedRange.Copy
            Windows("Universal SD Template.xlsm").Activate
            Sheets("111 Raw Data").Select
            Range("T3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Range("T2").Value = Dry1T
            Range("T2").Select
            Selection.TextToColumns Destination:=Range("T2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1)), TrailingMinusNumbers:=True
            Range("T3").Select
            Selection.TextToColumns Destination:=Range("T3"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(22, 1)), TrailingMinusNumbers _
            :=True
            Workbooks.Open fileName:=Dry1T
            ActiveWindow.Close False
    End If
        
End If


End Sub
 
Upvote 0
As written, the projectFolder string is "" in Spec1. You need to specify projectFolder as an argument to Spec1 and pass it from the main routine, like this:

Code: 
If projectFolder <> "" Then

        Call Spec1(projectFolder)

Code: 
Sub Spec1(projectFolder As String)

Dim TestNum As String
Dim basePath As String, fileName As String
'Dim projectFolder As String <------ delete this line
Do the same for the other Calls and Subs.
 
Upvote 0
Im having trouble with the dir function. Can I not use it multiple times? I just want to be able to open files that end with these strings and also the number at the end will increase from 1-6. Is there a better way to do it? The files will always be in a folder named the test number.



Breakin1 = Dir(projectFolder & "*Breakin_Speed_1.csv")
Breakin1T = Dir(projectFolder & "*Breakin_Trigger_1.csv")
Wet1 = Dir(projectFolder & "*Wet_Speed_1.csv")
Wet1T = Dir(projectFolder & "*Wet_Trigger_1.csv")
Dry1 = Dir(projectFolder & "*Dry_Speed_1.csv")
Dry1T = Dir(projectFolder & "*Dry_Trigger_1.csv")
 
Upvote 0
What is the problem with the Dir function? It just returns the first file name matching a (wildcarded) file spec. Yes, you can call it multiple times in sequence like above, but not in a Dir loop with different directories because it loses context.

For looping through files _1 to _6 you could do this:
Code: 
    For i = 1 To 6
        Breakin = Dir(projectFolder & "*Breakin_Speed_" & i & ".csv")
        If Breakin <> vbNullString Then
            'File exists - process it here
        End If
    Next
Notice the use of vbNullString instead of "".
 
Upvote 0
Im not sure what the problem is. I keep getting runtime error 1004 and says sorry we couldnt find the file even though the file is sitting in the correct folder...
 
Upvote 0
In your code the Breakin1 variable contains just the file name. You need to prepend the folder path to open the file:
Code: 
            Workbooks.Open fileName:=ProjectFolder & Breakin1
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA script - split sheets into unique folder named of cell entry
Replies
7
Views
503
james00
J
F
  • Solved
macro to input folder name to get data
Replies
3
Views
238
Micron
M
C
  • Question Question
VBA-Photos to be imported from Sharepoint Site rather than local drive
Replies
1
Views
524
Micron
M
M
  • Question Question
Open PDF files when click specific cell within folers and subfolers in directory
Replies
0
Views
213
Mussala
M
C
  • Solved
vba to rename files in folders, subfolders and sub-subfolders
Replies
2
Views
3K
cjcass
C

Forum statistics

Threads
1,223,249
Messages
6,171,031
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top