View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
RompStar RompStar is offline
external usenet poster
 
Posts: 29
Default Excel 2003 VBA Help me complete this Search script

Hi there,

This is a Sub and a Function. I am relatively new to VBA scripting
for Excel 2003. What I am trying to accomplish is this.

Have this FileSeach look into the path specified and it's sub-
directories, and then refer to the function and try to find all file
names of *.xls type that range within a cetain dates, or a single date
if there is no range in dates. The file names that I am looking for
will have this pattern:

filename_blablablablabla_20071201.xls - always at the end it there
will be a date, using YYYYMMDD.

Since Excel probably havs't a clue about dates in the file names, I
figured I have to somehow teach this to Excel to look in a pre-
determined pattern in the string of the file name and format that as a
date and then maybe I can search a between conditions:

Then the found directory paths would be pasted into the Excel sheet
starting A1 and down.

If anyone knows how to do this in XP using DOS, let me know too :- )



So if I was using this (from the function):

FromDate = "20071201" YYYYMMDD format
ToDate = "20071212"

I would like it to find all the files that are between *20071201.xls -
*20071212.xls, including the Dates them self, if nothing in-between
exists.

I hope I sounds clear, please post back to this forum, so that if is a
success, others can use it as well.

Sub FileFound(strFileName As String)

Dim path As Variant
Dim strDllNms As String

Set fs = Application.FileSearch

With fs
.LookIn = "c:\Kevin\"
.SearchSubFolders = True
.Filename = strFileName & "*.xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
Else
MsgBox "There were no files found."
End If

ActiveSheet.Range("A2") =
Application.Transpose(ExtractNewFileName(strFileNa me))
Cells.EntireColumn.AutoFit

End With

End Sub




Function ExtractNewFileName(strOldFName As String) As String

Dim strFn As String
Dim FromDate, ToDate As String

FromDate = "20071201"
FromDate = Format("YYYYMMDD")
ToDate = "20071212"
ToDate = Format("YYYYMMDD")

strFn = Left(strOldFName, InStrRev(strOldFName, ".", -1,
vbTextCompare) - 1)
strFn = strFn & "_" & Format("YYYYMMDD") & ".xls"

If strFn = strFn & "_" & FromDate - ToDate & ".xls" Then
ExtractNewFileName = strFn
Else
ExtractNewFileName = "nothing found"
End If

End Function