Hello,<o
></o>Iam a fairly big VBA noob and have been searching many forums for an answer tomy problem. I am having an issue with the application.filesearch in 2003 notworking in 2007/2013. I was wondering if anybody could help me re-write thecode to work in Office 2013. The code is pretty basic. Any help would begreatly appreciated. I believe the "find files" is the only sectionthat needs updated. Thanks in advance for your help!<o
></o>Sub Database()
Dim fn, m, d, X, c
If Day(Now()) = 1 Then
Select Case Month(Now() - 10)
Case Is = 1
X = "January"
Case Is = 2
X = "February"
Case Is = 3
X = "March"
Case Is = 4
X = "April"
Case Is = 5
X = "May"
Case Is = 6
X = "June"
Case Is = 7
X = "July"
Case Is = 8
X = "August"
Case Is = 9
X = "September"
Case Is = 10
X = "October"
Case Is = 11
X = "November"
Case Is = 12
X = "December"
End Select
Else
Select Case Month(Now())
Case Is = 1
X = "January"
Case Is = 2
X = "February"
Case Is = 3
X = "March"
Case Is = 4
X = "April"
Case Is = 5
X = "May"
Case Is = 6
X = "June"
Case Is = 7
X = "July"
Case Is = 8
X = "August"
Case Is = 9
X = "September"
Case Is = 10
X = "October"
Case Is = 11
X = "November"
Case Is = 12
X = "December"
End Select
End If
Sheets("Database").Cells(45, 1).Resize(65000, 15).ClearContents
Sheets("Non Prod Database").Cells(30, 1).Resize(65000, 5).ClearContents
'''''''''''''''''''''''Find Files
With Application.FileSearch
.NewSearch
.LookIn = "S:\Corr\Corr Rep Prod 14"
.SearchSubFolders = True
.Filename = X
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
'''''''Import Into Excel
For i = 1 To .FoundFiles.Count
fn = .FoundFiles(i)
Workbooks.Open Filename:=fn, ReadOnly:=True
fn = ActiveWorkbook.Name
For d = 2 To Worksheets.Count
Sheets(d).Select
Cells(5, 2).Select
If Cells(5, 2) = "" And Cells(6, 11) = "" Then
GoTo Nextd1
End If
ActiveSheet.Unprotect
c = Cells(1, 8).Value
Selection.CurrentRegion.Select
Selection.Offset(2, 0).Resize(Selection.Rows.Count - (92 - c), Selection.Columns.Count - 3).Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Database").Activate
Range("A45").Select
If Range("A45") = "" Or Range("A46") = "" Then
ActiveCell.Offset(0, 1).Select
Else
Selection.End(xlDown).Select
ActiveCell.Offset(1, 1).Select
End If
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Selection.Resize(Selection.Rows.Count + 1, 1).Offset(0, -1).Select
Selection.Value = Workbooks(fn).Name
Selection.Offset(Selection.Rows.Count - 1, 10).Resize(1, 1).Select
Selection = Workbooks(fn).ActiveSheet.Cells(6, 11)
Workbooks(fn).Activate
Cells(12, 11).Resize(35, 2).Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Non Prod Database").Activate
Range("A27").Select
If Range("A27") = "" Or Range("A28") = "" Then
ActiveCell.Offset(0, 1).Select
Else
Selection.End(xlDown).Select
ActiveCell.Offset(1, 1).Select
End If
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Selection.Resize(Selection.Rows.Count + 1, 1).Offset(0, -1).Select
Selection.Value = Workbooks(fn).Name
Workbooks(fn).Activate
Nextd1:
Next d
Workbooks(fn).Activate
ActiveWorkbook.Close SaveChanges:=False
Next i
Else
End If
End With
Worksheets("Non Prod Database").Activate
Cells(1, 1).Select
For X = 1 To Selection.CurrentRegion.Rows.Count
If Cells(X, 3) = "Lunch" Then
Cells(X, 3).ClearContents
Cells(X, 2).ClearContents
End If
Next X
End Sub
Last edited:
