Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel 2003 VBA Help me complete this Search script
This should return the last eight characters of the file name minus the 4
digit file extension. If you are using xl2007, change the 11 to 12. Mid(FileName,Len(FileName)-11, 8) =20071201 And Mid(FileName,Len(FileName)-11, 8) <= 20071212 Looks a little cumbersome but I believe it will return your dates. I have not tried it so be careful. "RompStar" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel 2003 VBA Help me complete this Search script
This is how I have it now. I tried to step into the Sub in the VBE,
but it won't let me, nothing is happening, and the Sub don't show as a Marco that I can play, so I think I am doing something wrong: Sub FileFound(strFileName As String) Dim path As Variant Set fs = Application.FileSearch With fs .LookIn = "c:\Kevin\" .SearchSubFolders = True .Filename = strFileName & "*.txt" .FileType = msoFileTypeAllFiles If .Execute() 0 Then MsgBox "There were " & .FoundFiles.Count & " file(s) found." Else MsgBox "There were no files found." End If ActiveSheet.Range("A1") = Application.Transpose(ExtractNewFileName(strFileNa me)) Cells.EntireColumn.AutoFit End With End Sub Function ExtractNewFileName(Filename As String) As String Dim strFn As String strFn = Mid(Filename, Len(Filename) - 11, 8) = 20071201 And Mid(Filename, Len(Filename) - 11, 8) <= 20071212 ExtractNewFileName = strFn End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel 2003 + script to open and automatically close an excel workb | Excel Discussion (Misc queries) | |||
Trying to convert a excel 2003 to 2007, but it contain script. | Excel Discussion (Misc queries) | |||
Trying to convert a excel 2003 to 2007, but it contain script. | New Users to Excel | |||
Where can I find a free trial of excel and access 2003 complete? | Excel Discussion (Misc queries) | |||
In search of VBA script | Excel Programming |