You are here:

Excel/VBA Open file with wildcard

Advertisement


Question
QUESTION: Excel 2007 VBA
Hi Tom,
Well, in the abbreviated code below, colA of shData will show a file name of "monkey". However, it needs to find and open a file named "monkey0512.xls" (to be opened as bkClient.shClient)
I'm having no success using wildcards to do this. Can you help?
Thanks!
Sub MyCode()
   Dim bkData As Workbook
   Dim shData As Worksheet
   Dim bkClient As Workbook
   Dim shClient As Worksheet
   Dim r As Range, cell As Range
   Dim fName As Variant
   Dim sPath As String  'For Template
   Dim sPathN As String  'For Data, Client files
   Dim s As String, olds As String, news As String
   Dim icnt As Long, jcnt As Long, ii As Long
   Dim sTempBk As String
' Set the directory that has Template here: make sure this ends with a back slash
   sPath = "C:\MyDocs\"
   sTempBk = sPath & "newclienttemplate.xls"
'Open the dialog box to select the data file
   ChDrive sPath
   ChDir sPath
   fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls?),*.xls?", _
     Title:="Select Datafile then click on Open", MultiSelect:=False)
   If TypeName(fName) = "Boolean" Then
     MsgBox "No file selected.  Exiting . . . "
     Exit Sub
   End If
'OPEN THE SELECTED DATA FILE
   Workbooks.Open fName
   Set bkData = ActiveWorkbook
   Set shData = ActiveSheet
'Sets the path = wherever the file that was just opened is located.
'This should be where data, client files are all located
   sPathN = ActiveWorkbook.Path & "\"
   
' Sort on A then B, sorts thru ColS
'set the range where filenames are found
   Set r = shData.Range("A2", shData.Cells(shData.Rows.Count, "A").End(xlUp))
'set the vertical range for each file name in ColA
   icnt = 0
   For Each cell In r
   icnt = icnt + 1
   s = cell.Value & ".xls"   'grab a file name and add extension
   news = cell.Value 'for when we do SaveAs at end
'BEGIN THE LOOP
'jcnt=# rows for file
   If s <> olds Then
       ii = icnt
       jcnt = 1
         Do While r(ii).Value = cell.Value
         jcnt = r(ii).Row - cell.Row + 1
         ii = ii + 1
       Loop
   
'OPEN CLIENT FILE AND SET AS ACTIVE SHEET
'If this is a new client, open Template, SaveAs bkClient.shClient and work on it
   Set bkClient = Nothing
      On Error Resume Next
         Set bkClient = Workbooks.Open(sPathN & s)
      On Error GoTo 0
      If bkClient Is Nothing Then
         Set bkClient = Workbooks.Open(sTempBk)
         bkClient.SaveAs sPathN & s
      End If
      Set shClient = ActiveSheet

'*****PROCESSING*****
   With bkClient
       .SaveAs sPathN & news & ".xls"
       .Close
   End With
   Set bkClient = Nothing
   olds = s
   End If    'ENDS THE IF FROM BEGIN THE LOOP
   Next
   End Sub

ANSWER: Doug,

Untested, but compiled OK.

It gets a list of all files in the subject directory that ends with .xls
It then takes the value in you list and loops through this list.  It picks the first file name in the directory that matches the value in your list.  

if you had a monkey512.xls and a monkey514.xls in your directory, then this will not work and your are out of luck.

Sub MyCode()
   Dim bkData As Workbook
   Dim shData As Worksheet
   Dim bkClient As Workbook
   Dim shClient As Worksheet
   Dim r As Range, cell As Range
   Dim fName As Variant
   Dim sPath As String  'For Template
   Dim sPathN As String  'For Data, Client files
   Dim s As String, olds As String, news As String
   Dim icnt As Long, jcnt As Long, ii As Long
   Dim sTempBk As String
   Dim sName As String, i As Long, v As Variant
   Dim s1 As String, s2 As String, s3 As String
' Set the directory that has Template here: make sure this ends with a back slash
   sPath = "C:\MyDocs\"
   sTempBk = sPath & "newclienttemplate.xls"
'Open the dialog box to select the data file
   ChDrive sPath
   ChDir sPath
   fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls?),*.xls?", _
     Title:="Select Datafile then click on Open", MultiSelect:=False)
   If TypeName(fName) = "Boolean" Then
     MsgBox "No file selected.  Exiting . . . "
     Exit Sub
   End If
'OPEN THE SELECTED DATA FILE
   Workbooks.Open fName
   Set bkData = ActiveWorkbook
   Set shData = ActiveSheet
'Sets the path = wherever the file that was just opened is located.
'This should be where data, client files are all located
   sPathN = ActiveWorkbook.Path & "\"
    ' get a list of all files in the specified path with extension .xls
    ReDim v(1 To 1)
    sName = Dir(sPathN & "*.xls")
    Do While sName <> ""
      v(UBound(v)) = sName
      ReDim Preserve v(1 To UBound(v) + 1)
    Loop
    ReDim Preserve v(1 To UBound(v) - 1)
' Sort on A then B, sorts thru ColS
'set the range where filenames are found
   Set r = shData.Range("A2", shData.Cells(shData.Rows.Count, "A").End(xlUp))
'set the vertical range for each file name in ColA
   icnt = 0
   For Each cell In r
   icnt = icnt + 1
   s1 = cell.Value
   s3 = cell.Value
   s = cell.Value & ".xls"   'grab a file name and add extension
   s2 = ""
   For i = 1 To UBound(v)
     If InStr(1, v(i), s1, vbTextCompare) = 1 Then
        s2 = v(i)
        s3 = Left(v(i), InStrRev(v(i), ".", -1, vbTextCompare) - 1)
        Exit For
     End If
   Next
   If s2 = "" Then
      s2 = s
      s3 = s1
   End If
   news = s3   ' cell.Value 'for when we do SaveAs at end
'BEGIN THE LOOP
'jcnt=# rows for file
   If s <> olds Then
       ii = icnt
       jcnt = 1
         Do While r(ii).Value = cell.Value
         jcnt = r(ii).Row - cell.Row + 1
         ii = ii + 1
       Loop
   
'OPEN CLIENT FILE AND SET AS ACTIVE SHEET
'If this is a new client, open Template, SaveAs bkClient.shClient and work on it
   Set bkClient = Nothing
      On Error Resume Next
         Set bkClient = Workbooks.Open(sPathN & s2)
      On Error GoTo 0
      If bkClient Is Nothing Then
         Set bkClient = Workbooks.Open(sTempBk)
         bkClient.SaveAs sPathN & s2
      End If
      Set shClient = ActiveSheet

'*****PROCESSING*****
   With bkClient
       .SaveAs sPathN & news & ".xls"
       .Close
   End With
   Set bkClient = Nothing
   olds = s
   End If    'ENDS THE IF FROM BEGIN THE LOOP
   Next
   End Sub

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: Tom,
I'm getting a Run Time Error 13 Type Mismatch here:

For i = 1 To UBound(v)

I couldn't get any further than that.

Best regards,
Doug

Answer
Doug,

Here is a little tester routine with the critical code in it:

Sub abc()
  Dim sPathN As String
  Dim i As Long
  Dim v As Variant
  Dim sName As String, s2 As String, s3 As String
  sPathN = "D:\C_Drive\Data\"
  ReDim v(1 To 1)
    sName = Dir(sPathN & "*.xls")
    Do While sName <> ""
      v(UBound(v)) = sName
      ReDim Preserve v(1 To UBound(v) + 1)
      sName = Dir()
    Loop
    ReDim Preserve v(1 To UBound(v) - 1)
    
   For i = 1 To UBound(v)
  '   If InStr(1, v(i), s1, vbTextCompare) = 1 Then
        s2 = v(i)
        s3 = Left(v(i), InStrRev(v(i), ".", -1, vbTextCompare) - 1)
  '     Exit For
        Debug.Print s2, s3
  '   End If
   Next
End Sub


change the path to represent you path and make sure it ends with a backslash (\)

Now there is a line of code missing in the code I posted - the hazard of not being able to test the code.

Sub MyCode()
   Dim bkData As Workbook
   Dim shData As Worksheet
   Dim bkClient As Workbook
   Dim shClient As Worksheet
   Dim r As Range, cell As Range
   Dim fName As Variant
   Dim sPath As String  'For Template
   Dim sPathN As String  'For Data, Client files
   Dim s As String, olds As String, news As String
   Dim icnt As Long, jcnt As Long, ii As Long
   Dim sTempBk As String
   Dim sName As String, i As Long, v As Variant
   Dim s1 As String, s2 As String, s3 As String
' Set the directory that has Template here: make sure this ends with a back slash
   sPath = "C:\MyDocs\"
   sTempBk = sPath & "newclienttemplate.xls"
'Open the dialog box to select the data file
   ChDrive sPath
   ChDir sPath
   fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls?),*.xls?", _
     Title:="Select Datafile then click on Open", MultiSelect:=False)
   If TypeName(fName) = "Boolean" Then
     MsgBox "No file selected.  Exiting . . . "
     Exit Sub
   End If
'OPEN THE SELECTED DATA FILE
   Workbooks.Open fName
   Set bkData = ActiveWorkbook
   Set shData = ActiveSheet
'Sets the path = wherever the file that was just opened is located.
'This should be where data, client files are all located
   sPathN = ActiveWorkbook.Path & "\"
    ' get a list of all files in the specified path with extension .xls
    ReDim v(1 To 1)
    sName = Dir(sPathN & "*.xls")
    Do While sName <> ""
      v(UBound(v)) = sName
      ReDim Preserve v(1 To UBound(v) + 1)
      sName = dir()  ' <=========== Added line of code
    Loop
    ReDim Preserve v(1 To UBound(v) - 1)
' Sort on A then B, sorts thru ColS
'set the range where filenames are found
   Set r = shData.Range("A2", shData.Cells(shData.Rows.Count, "A").End(xlUp))
'set the vertical range for each file name in ColA
   icnt = 0
   For Each cell In r
   icnt = icnt + 1
   s1 = cell.Value
   s3 = cell.Value
   s = cell.Value & ".xls"   'grab a file name and add extension
   s2 = ""
   For i = 1 To UBound(v)
     If InStr(1, v(i), s1, vbTextCompare) = 1 Then
        s2 = v(i)
        s3 = Left(v(i), InStrRev(v(i), ".", -1, vbTextCompare) - 1)
        Exit For
     End If
   Next
   If s2 = "" Then
      s2 = s
      s3 = s1
   End If
   news = s3   ' cell.Value 'for when we do SaveAs at end
'BEGIN THE LOOP
'jcnt=# rows for file
   If s <> olds Then
       ii = icnt
       jcnt = 1
         Do While r(ii).Value = cell.Value
         jcnt = r(ii).Row - cell.Row + 1
         ii = ii + 1
       Loop
   
'OPEN CLIENT FILE AND SET AS ACTIVE SHEET
'If this is a new client, open Template, SaveAs bkClient.shClient and work on it
   Set bkClient = Nothing
      On Error Resume Next
         Set bkClient = Workbooks.Open(sPathN & s2)
      On Error GoTo 0
      If bkClient Is Nothing Then
         Set bkClient = Workbooks.Open(sTempBk)
         bkClient.SaveAs sPathN & s2
      End If
      Set shClient = ActiveSheet

'*****PROCESSING*****
   With bkClient
       .SaveAs sPathN & news & ".xls"
       .Close
   End With
   Set bkClient = Nothing
   olds = s
   End If    'ENDS THE IF FROM BEGIN THE LOOP
   Next
   End Sub

--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.