View Full Version : Excel 2007 file search
khalid79m
01-10-2010, 06:25 AM
Sub A()
Dim I As Integer, wb As Workbook
Dim sLook() As String, vLook As Variant
ReDim sLook(1 To 1) As String 'change the slook to suit the number of different locations
sLook(1) = "C:\Users\nn\Documents\Historic_Data\34SCA\"
For Each vLook In sLook()
With Application.FileSearch ' code fails here
.NewSearch
.LookIn = vLook
.SearchSubFolders = True
.Filename = "*.xls"
.Application.DisplayAlerts = False
.Execute
For I = 1 To .FoundFiles.Count
MsgBox vLook
'Set wb = Workbooks.Open(Filename:=.FoundFiles(I), ReadOnly:=True)
'wb.Close Savechanges:=False
Next I
End With
Next vLook
End Sub
this a snippet of code i have , our systems have gone from 2003 to 2007 and the filesearch function doesnt work :( can anyone amend this code, i have no idea on how to do it
Bob Phillips
01-10-2010, 06:36 AM
Sub A()
Dim wb As Workbook
Dim sLook() As String, vLook As Variant
Dim fName As String
ReDim sLook(1 To 2) As String 'change the slook to suit the number of different locations
sLook(1) = "C:\Users\nn\Documents\Historic_Data\34SCA\"
sLook(2) = "C:\test\"
For Each vLook In sLook
fName = Dir(vLook & "*.xls")
Do While fName <> ""
MsgBox fName
'Set wb = Workbooks.Open(Filename:=vlook & fname, ReadOnly:=True)
'wb.Close Savechanges:=False
fName = Dir
Loop
Next vLook
End Sub
khalid79m
01-10-2010, 06:39 AM
will this cover subfolders ?
khalid79m
01-10-2010, 07:16 AM
:dunno :dunno I need the code to be able to search sub folders.
can anyone help
Bob Phillips
01-10-2010, 07:57 AM
Sub A()
Dim FSO As Object
Dim wb As Workbook
Dim sLook() As String, vLook As Variant
Dim fName As String
ReDim sLook(1 To 2) As String 'change the slook to suit the number of different locations
sLook(1) = "C:\Users\nn\Documents\Historic_Data\34SCA\"
sLook(2) = "C:\test\"
Set FSO = CreateObject("Scripting.FilesystemObject")
For Each vLook In sLook
Call ProcessFolder(FSO, CStr(vLook))
Next vLook
End Sub
Private Function ProcessFolder(FSO As Object, FolderName As String)
Dim Folder As Object
Dim SubFolder As Object
Dim File As Object
On Error Resume Next
Set Folder = FSO.getfolder(FolderName)
On Error GoTo 0
If Not Folder Is Nothing Then
For Each File In Folder.Files
If File.Type Like "*Office Excel*" Then
MsgBox File.Name
'Set wb = Workbooks.Open(Filename:=vlook & fname, ReadOnly:=True)
'wb.Close Savechanges:=False
End If
Next File
For Each SubFolder In Folder.SubFolders
Call ProcessFolder(FSO, FolderName & SubFolder.Name & "\")
Next SubFolder
End If
Set Folder = Nothing
Set SubFolder = Nothing
End Function
khalid79m
01-10-2010, 08:52 AM
Sorry XLD I have written this code before you put your respons on , it is quite similar
I need help though, I would like make to make some tweeks, i have marked them on the code
Private Sub FileNamesSET()
Dim sLook() As String, vLook As Variant
ReDim sLook(1 To 1) As String
sLook(1) = "C:\Users\MK\Documents\Historic_Data\"
For Each vLook In sLook()
SelectFiles vLook
Next vLook
Application.DisplayAlerts = True
End Sub
Private Sub SelectFiles(sPath)
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr
Dim oFSO As Object
Dim Lastrow1 As Long
Dim Source As String
Dim Destination As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Folder = oFSO.GetFolder(sPath)
For Each fldr In Folder.SubFolders
SelectFiles fldr.Path
Next fldr
For Each file In Folder.Files
Workbooks.Open (file), , True
Source = file.Name
' how do I set the sheet name to the file.name but exlude the .xls so if the file was called Easy.xls then sheet would be Easy
Lastrow1 = Workbooks(Source).Sheets().Cells(Cells.Rows.Count, "A").End(xlUp).Row
Workbooks(Source).Sheets().Range("A2:D" & Lastrow1).Copy
' how do I set the sheet name to the 2 folder up for example
'C:\Users\MK\Documents\Historic_Data\
'C:\Users\MK\Documents\Historic_Data\34SCA
'C:\Users\MK\Documents\Historic_Data\34SCA\2008
'C:\Users\MK\Documents\Historic_Data\34SCA\2009
'SO the destination sheet name would be 34SCA
Lastrow1 = Workbooks(Destination).Sheets().Cells(Cells.Rows.Count, "A").End(xlUp).Row
Workbooks(Destination).Sheets().Range("A2" & Lastrow1 + 1).pastespecial
'Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = file.Name
Next file
Set oFSO = Nothing
End Sub
khalid79m
01-10-2010, 09:58 AM
Hi can anyone help
i need to trim this
Source_Wkb = File.Name (this correct)
Source_Wkst = File.Name (I need to trim the .xls off this)
the file.name is test.xls
Bob Phillips
01-10-2010, 11:06 AM
Replace(File.Name,".xls","")
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.