PDA

View Full Version : how to reset the value of .FileSearch to null or nothing?



rrosa1
12-07-2010, 01:44 AM
hi
how to reset the value of .FileSearch to null or nothing to restart the search
in my code if i run the following code first time and the specific file is in folder then code does copy/paste from the anther wb but if i move the file from the folder and run the code it give msg "file not in folder " that also work.
but then i move the file back to the same folder and run the macro it still give the msg "file not in folder " where as i just move the file in same folder.

Thanks and appreciate all helps

Option Explicit
Private wb As Workbook
Const FILE_PATH As String = "C:\Documents and Settings\Srusty\My Documents\2010\"
Const FILE_PATH2 As String = "C:\Documents and Settings\Srusty\My Documents\"
Const FILE_NAME As String = "06.xls"
Const FILE_NAME2 As String = "07.xls"
Dim BR As Long
'

Sub GD_New()
Dim ws As Worksheet
'sub TData
Dim ws5 As Worksheet
Dim LastRow1 As Long
Dim ws6 As Worksheet
Dim ws1 As Worksheet
Dim sname As String
Dim i As Long
Dim WB2 As Workbook
Dim Lastrow As Long
With Application
'.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
'# Delete the sheet "Rev " if it exist
On Error Resume Next
ActiveWorkbook.Worksheets("Rev").Delete
On Error GoTo search '0

search:
With Application
With .FileSearch
.NewSearch
.LookIn = FILE_PATH & FILE_NAME
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then

Set wb = Workbooks.Open(Filename:=FILE_PATH & FILE_NAME)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Rev"
wb.Worksheets(1).Range("B1").Copy Destination:=Sheets("Rev").Range("A10")
Set ws6 = wb.Worksheets("Rev")
For i = wb.Sheets.Count To 1 Step -1
With wb.Sheets(i)
If .Range("A1") = "Date." Then
wb.Sheets(i).Range("A3:D3").Copy
'4 for copy in 4th row in sheet1 u can use one sheet or defferent sheet from each book
ws6.Cells(11, 1).Insert Shift:=xlShiftDown
'1 for coloumn 1
End If
End With
Next
With ws6
.Range("A10").NumberFormat = "@"
.Range("A10") = Format(.Range("A10"), "mmm-yy")
End With
sname = Range("A10").Value
wb.Worksheets("Rev").Activate
wb.Worksheets("Rev").Move before:=ThisWorkbook.Sheets("Summary")
wb.Close SaveChanges:=False 'True

Else: MsgBox FILE_NAME & " Not Found in folder."
GoTo Err
End If
End With

With .FileSearch
.NewSearch
.LookIn = FILE_PATH2 & FILE_NAME2
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then

'Open up your second workbook, copy data
Set WB2 = Workbooks.Open(Filename:=FILE_PATH2 & FILE_NAME2)
WB2.Sheets("Month Total").Range("B2:C32").Copy
ThisWorkbook.Sheets("Rev").Range("E11:F35").PasteSpecial xlValues
'Close second workbook
WB2.Close SaveChanges:=False
If ActiveWorkbook Is Nothing Then Exit Sub
Dim ii#
If ActiveWindow.SelectedSheets.Count > 1 Then
For ii = 1 To ActiveWindow.SelectedSheets.Count
ActiveWindow.SelectedSheets(ii).Cells.EntireColumn.AutoFit
Next
Else
Cells.EntireColumn.AutoFit
End If
On Error Resume Next
wb.Worksheets(sname).Delete
On Error GoTo 0
ThisWorkbook.Sheets("Rev").Name = sname

Else
MsgBox FILE_NAME2 & " Not Found in folder."
GoTo Err
End If

End With
End With
Err:
With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

Simon Lloyd
12-07-2010, 03:16 AM
You will need to declare you variables as vbNullString or "" at the end of your procedure to prevent them from remaining in public memory.

Bob Phillips
12-07-2010, 04:20 AM
I can't see that, every time you re-run the procedure you re-initialise the search.

Simon Lloyd
12-07-2010, 05:28 AM
Hi Bob, i was puzzled too as public memory variables are overwritten on next run so dont really need releasing from memory (or thats how i've always perceived the concept), all i could imagine is that it was not re-reading the state of the constants, but i thought declared constants in a public module would remain unchanged through any procedure no matter how many times its run (im assuming this is all in a public module).

Bob Phillips
12-07-2010, 05:39 AM
Maybe so Simon, but the code does a .NewSearch, which means it should find what is there.

rrosa1
12-07-2010, 06:31 PM
hi
Bob and simon
thanks for looking in to my problem but i find this code in KB in this forum
and i play with some what to make it work for me.
i am no pro like u guys so pl look in my code is i am doing right.
thanks again u both help me lot to learn.

inseated of this code
With Application
With .FileSearch
.NewSearch
.LookIn = FILE_PATH & FILE_NAME
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then


i used this and it work
With Application.FileSearch
.LookIn = FILE_PATH '& FILE_NAME
.Filename = FILE_NAME '"*.xls" '<< only search workbooks
If .Execute > 0 Then
For N = 1 To .FoundFiles.Count
If .FoundFiles(N) = FILE_PATH & FILE_NAME Then

Bob Phillips
12-08-2010, 12:58 AM
rrosa1,

Can you post the other workbooks and then we can try and emulate the situation?

rrosa1
12-08-2010, 09:33 PM
hi xld
here is all three wb with in folder .
and also can u check this code i need to copy only value the following code work but it copy formula which i don't need.
also i need to modify to check value in column "A" in the "T_Mth" sh. if value in column find than do nothing else copy data from "summary" sh to "M_Th" sh.
thanks for you time it's appreciated.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Count > 1 Then Exit Sub
If Target.Address <> "$A$7" Then GoTo n1 'Exit Sub

Dim wss As Worksheet
Dim wst As Worksheet

Set wss = ThisWorkbook.Worksheets("Summary")
Set wst = ThisWorkbook.Worksheets("T_Mth")
Sheets("Summary").Unprotect Password:=""
Sheets("T_Mth").Unprotect Password:=""
If MsgBox("Send Data to All Data Sheet?", vbYesNo) = vbYes Then
Cancel = True
Range(Cells(Target.Row, "A"), Cells(Target.Row, "N")).Copy _
Sheets("T_Mth").Range("a3").Offset(0, 0) '.PasteSpecial.Offset(0, 0) 'xlValues ' & Rows.Count).End(xlUp).Offset(1, 0)
End If
n1:
If Target.Count > 1 Then Exit Sub
If Target.Address <> "$A$8" Then Exit Sub
If MsgBox("Send Data to All Data Sheet?", vbYesNo) = vbYes Then
Cancel = True

Range(Cells(Target.Row, "A"), Cells(Target.Row, "M")).Copy _
Sheets("T_Mth").Rows("10:15").EntireRow.Insert

ThisWorkbook.Worksheets("T_Mth").Activate

End If
Application.CutCopyMode = False
End Sub