A
Al
Hello
I am trying to modify the following code to open all files in current folder
*a.csv The code now opens the same files saved as xls. How do I modify to
open CSV?
Im guessing its in
.FileType = msoFileTypeExcelWorkbooks
and
If InStr(1, .FoundFiles(i), "A.xls", vbTextCompare) Then
But Im not sure of syntax.....
Sub Summary()
Dim myCell As Range
Dim myBook As Workbook
Dim i As Long
Dim r As Range, r1 As Range
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.NewSearch
'Copy or move this workbook to the folder with
'the files that you want to summarize
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
If InStr(1, .FoundFiles(i), "A.xls", vbTextCompare) Then
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets("Table").Select
Set r = myBook.Worksheets("Table").Range("a3:f51")
Set r1 = ThisWorkbook.Worksheets(1). _
Range("a65536").End(xlUp)
If r1.Row = 1 Then Set r1 = r1.Offset(1, 0)
If Not IsEmpty(r1) Then Set r1 = r1.Offset(1, 0)
r.Copy Destination:=r1
myBook.Close SaveChanges:=False
End If ' Instr
End If ' not thisworkbook
Next i
End If
End With
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
ThisWorkbook.SaveAs Application.GetSaveAsFilename
End Sub
Thanks!!
I am trying to modify the following code to open all files in current folder
*a.csv The code now opens the same files saved as xls. How do I modify to
open CSV?
Im guessing its in
.FileType = msoFileTypeExcelWorkbooks
and
If InStr(1, .FoundFiles(i), "A.xls", vbTextCompare) Then
But Im not sure of syntax.....
Sub Summary()
Dim myCell As Range
Dim myBook As Workbook
Dim i As Long
Dim r As Range, r1 As Range
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.NewSearch
'Copy or move this workbook to the folder with
'the files that you want to summarize
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
If InStr(1, .FoundFiles(i), "A.xls", vbTextCompare) Then
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets("Table").Select
Set r = myBook.Worksheets("Table").Range("a3:f51")
Set r1 = ThisWorkbook.Worksheets(1). _
Range("a65536").End(xlUp)
If r1.Row = 1 Then Set r1 = r1.Offset(1, 0)
If Not IsEmpty(r1) Then Set r1 = r1.Offset(1, 0)
r.Copy Destination:=r1
myBook.Close SaveChanges:=False
End If ' Instr
End If ' not thisworkbook
Next i
End If
End With
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
ThisWorkbook.SaveAs Application.GetSaveAsFilename
End Sub
Thanks!!