Need wild card in vba code

[Shazam]

Hi everyone,

THe code in the bottom will open a list of files on the excel worksheet and combind them into one workbook.

My problem is the list on the worksheet is by date only but the actual file names are, Example:

Metal 05-01-2006
Metal 05-02-2006
Metal 05-03-2006
thru
Metal 05-31-2006

How can we modify the code below with a wild card. Something like:

[vba]For Each q In "Metal "&Range("C5:AG5")[/vba]

Example workbook below.

[vba]
Sub Files()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Dim FileType As String


Application.ScreenUpdating = False
Path = "Z:\Performance\Metal Incentive\2006" 'Change as needed

For Each q In Range("C5:AG5")
On Error Resume Next
Set Wkb = Workbooks.Open(FileName:=Path & "\" & q.Value)
For Each WS In Wkb.Worksheets
If InStr(1, WS.Name, "Incentive") <> 0 Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next
Wkb.Close False

FileName = q()

Next q
On Error GoTo 0
End Sub
[/vba]

[Zack Barresse]

Try setting up the FSO option (FileScriptingObject). Set your folder, loop through the files, checking the first 6 characters ("Metal ") and running on each file. Check that they're open first of course. Post back if you need more help and with what you've tried.

Good luck FFF.

[malik641]

I've been using Matt's code that uses Dir() to return an array of files....(p.s. thanks Matt!!)

[vba]Function ReturnAllFilesUsingDir(ByVal vPath As String, ByRef vsArray() As String) As Boolean
Dim tempStr As String, vDirs() As String, Cnt As Long, dirCnt As Long
Dim PctDone As Long

'Set caption for progress bar
frmProgress.lblDescription = "Searching for Files..."
frmProgress.Repaint

If Len(vsArray(0)) = 0 Then
Cnt = 0
Else
Cnt = UBound(vsArray) + 1
End If
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
On Error GoTo BadDir
tempStr = Dir(vPath, 31)

Do Until Len(tempStr) = 0
If Asc(tempStr) <> 46 Then
If GetAttr(vPath & tempStr) And vbDirectory Then
ReDim Preserve vDirs(dirCnt)
vDirs(dirCnt) = tempStr
dirCnt = dirCnt + 1
End If
BadDirGo:
End If
tempStr = Dir
SkipDir:
Loop
On Error GoTo BadFile
tempStr = Dir(vPath, 15)
Do Until Len(tempStr) = 0
ReDim Preserve vsArray(Cnt)
vsArray(Cnt) = vPath & tempStr
Cnt = Cnt + 1
tempStr = Dir

'Update progress bar
PctDone = Cnt / (6500)
Call UpdateProgressBar(PctDone)
Loop
Debug.Print Cnt
BadFileGo:
On Error GoTo 0
If dirCnt > 0 Then
For dirCnt = 0 To UBound(vDirs)
If Len(Dir(vPath & vDirs(dirCnt))) = 0 Then
ReturnAllFilesUsingDir vPath & vDirs(dirCnt), vsArray
End If
Next
End If
Exit Function
BadDir:
If tempStr = "pagefile.sys" Or tempStr = "???" Then
' Debug.Print "DIR: Skipping: " & vPath & tempStr
Resume BadDirGo
ElseIf Err.Number = 52 Then 'or err.number=5 then
' Debug.Print "No read rights: " & vPath & tempStr
Resume SkipDir
End If
Debug.Print "Error with DIR (BadDir): " & Err.Number & " - " & Err.Description
Debug.Print " vPath: " & vPath
Debug.Print " tempStr: " & tempStr
Exit Function
BadFile:
If Err.Number = 52 Then 'or err.number=5 then
' Debug.Print "No read rights: " & vPath & tempStr
Else
Debug.Print "Error with DIR (BadFile): " & Err.Number & " - " & Err.Description
Debug.Print " vPath: " & vPath
Debug.Print " tempStr: " & tempStr
End If
Resume BadFileGo
End Function[/vba]

And this is how I use it:

[vba]Option Explicit
Option Compare Text
Sub ListFilesPattern()
'This will show all files that are found from a search
'given a path
Application.ScreenUpdating = False
Dim sPath As String, TempString As String
Static sFileName As String
Dim ws As Excel.Worksheet
Dim vsArray() As String
Dim i As Long, j As Long
Dim blnMatch As Boolean

ReDim vsArray(0)

sPath = "Z:\Drawings\"

TempString = sFileName
sFileName = InputBox("What's the File name like?", , sFileName)

If sFileName = "" Then
sFileName = TempString
Exit Sub
End If

If Right(sFileName, 1) <> "*" Then sFileName = sFileName & "*"

Call ReturnAllFilesUsingDir(sPath, vsArray())

ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)

Set ws = ActiveSheet
ws.Name = "Search Results" & " (" & Worksheets.Count - 2 & ")"

If Not IsError(vsArray(0)) Then
For i = LBound(vsArray()) To UBound(vsArray())
With Application.WorksheetFunction
TempString = Right(vsArray(i), Len(vsArray(i)) _
- .Find("*", .Substitute(vsArray(i), "\", "*", Len(vsArray(i)) _
- Len(.Substitute(vsArray(i), "\", "")))))

If TempString Like sFileName Then
blnMatch = True
j = j + 1
ws.Cells(j, 1).Value = vsArray(i)
ws.HyperLinks.Add Anchor:=ws.Cells(j, 1), Address:=vsArray(i), TextToDisplay:=vsArray(i)
End If
End With

Next
End If

If blnMatch = True Then
ws.UsedRange.Sort Key1:=ws.Range("A1"), Order1:=xlAscending
ws.Columns("A:A").EntireColumn.AutoFit
Else
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
MsgBox "No files found."
End If
Application.ScreenUpdating = True
End Sub[/vba]
This is used almost just like a windows search, I just like it in a spreadsheet . Note the bolded item, this is where you could put your pattern..something like
[vba]
If TempString Like "Metal*" Then
[/vba]



...Or something like that

[Shazam]

Thank you for replying guys. I think I got it I had to change this line:

[vba]Set Wkb = Workbooks.Open(FileName:=Path & "\" & q.Value)[/vba]

into

[vba]Set Wkb = Workbooks.Open(FileName:=Path & "\Metal " & q.Value)[/vba]

and it works fine.


How are you doing firefytr? Its' been awhile we have not talk.

[Zack Barresse]

Doing good buddy, been busy here with the new job, but I'm lovin' it!

Hope all has been well with you!