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
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