Loop through sub folders code

[jordanburch]

Hey all,

I have the following

Sub LoopThroughFolder()
Dim folderPath As String
Dim filename As String
Dim WB As Workbook

folderPath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Monthly Suspense Recon\"

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xls*")
Do While filename <> ""
Set WB = Workbooks.Open(folderPath & filename)

'Call a subroutine here to operate on the just-opened workbook
Call Clearedto

WB.Close False
filename = Dir
Loop

End Sub
Sub Clearedto()
Dim myfile As String
Dim myfile2 As String
Dim erow As Long

Dim wb1 As Workbook

Dim ShtName1 As String
Dim ShtName2 As String
Dim ShtName3 As String
ShtName1 = "Cleared - Cleared To"
ShtName2 = "Detail"
ShtName3 = "Detail -"


Application.ScreenUpdating = False

Set wb1 = ThisWorkbook

Dim strFileName As String
Dim strFileExists As String

strFileName = filepath & myfile
strFileExists = Dir(strFileName)


erow = wb1.Sheets("Cleared - Cleared To").Cells(Rows.Count, 14).End(xlUp).Offset(1, 0).Row

Dim ShtName As String
ShtName = "Cleared - Cleared To"
If Evaluate("isref('" & ShtName & "'!A1)") Then

With WB

Sheets("Cleared - Cleared To").Select
With ActiveSheet
If .AutoFilterMode Then
If .FilterMode Then
.ShowAllData
End If
Else
If .FilterMode Then
.ShowAllData
End If
End If
End With
If Evaluate("isref('" & ShtName1 & "'!A1)") Then
' wb2.Sheets("Cleared - Cleared To").Range("q2:q1000").Value = myfile
.Sheets("Cleared - Cleared To").Range("a2:AU20000").Copy Destination:=wb1.Worksheets("Cleared - Cleared To").Cells(erow, 1)

.Close savechanges:=False
ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
.Sheets("Detail Lines").Range("c21000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
.Close savechanges:=False

ElseIf Evaluate("isref('" & ShtName2 & "'!A1)") Then
.Sheets("Detail Lines").Range("c21000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
.Close savechanges:=False

End If


End With

Else
'sheet doesn't exist do something else
End If

Application.ScreenUpdating = True
End Sub

It is erroring out because its looking for all file types in the sub folders. I want it to only look for .xls file types. Any ideas?

Jordan

 

[DanteAmor]

filename = Dir(folderPath & "*.xls*")

It is erroring out because its looking for all file types in the sub folders. I want it to only look for .xls file types. Any ideas?

With that line you should filter only xls files. But if it isn't, try the following:

Sub LoopThroughFolder()
  Dim folderPath As String
  Dim filename As String
  Dim WB As Workbook
  
  folderPath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Monthly Suspense Recon\"
  
  If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
  
  filename = Dir(folderPath & "*.xls*")
  Do While filename <> ""
    If Right(filename, 4) Like "*xls*" Then
      Set WB = Workbooks.Open(folderPath & filename)
      'Call a subroutine here to operate on the just-opened workbook
      Call Clearedto
      WB.Close False
    End If
    filename = Dir
  Loop

End Sub

 

[jordanburch]

With that line you should filter only xls files. But if it isn't, try the following:

Sub LoopThroughFolder()
  Dim folderPath As String
  Dim filename As String
  Dim WB As Workbook
 
  folderPath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Monthly Suspense Recon\"
 
  If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
 
  filename = Dir(folderPath & "*.xls*")
  Do While filename <> ""
    If Right(filename, 4) Like "*xls*" Then
      Set WB = Workbooks.Open(folderPath & filename)
      'Call a subroutine here to operate on the just-opened workbook
      Call Clearedto
      WB.Close False
    End If
    filename = Dir
  Loop

End Sub

thanks Dante. Now its saying it cannot find a file thats in that folder, but that file isnt in the filepath that is listed I just want it to crawl through all subfolders and then search for that tab name and copy paste the data. Any thoughts?

 

[jordanburch]

thanks Dante. Now its saying it cannot find a file thats in that folder, but that file isnt in the filepath that is listed I just want it to crawl through all subfolders and then search for that tab name and copy paste the data. Any thoughts?

like it points to that filepath that is listed in the code and says sorry I cannot find xyz file, which it is not in the path at all and I expected it to not search for a file that isnt in the filepath. hopefully that makes more sense

 

[DanteAmor]

It is erroring out because its looking for all file types in the sub folders. I want it to only look for .xls file types. Any ideas?

I'm not understanding.
That is your original request, what does it mean?

 

[jordanburch]

thanks Dante. Now its saying it cannot find a file thats in that folder, but that file isnt in the filepath that is listed I just want it to crawl through all subfolders and then search for that tab name and copy paste the data. Any thoughts?

like it points to that filepath that is listed in the code and says sorry I cannot find xyz file, which it is not in the path at all and I expected it to not search for a file that isnt in the filepath. hopefully that makes more sense

I'm not understanding.
That is your original request, what does it mean?

basically its looking for a file in the file path that isnt there and erroring out and im not sure as to why?

 

[DanteAmor]

I'm not understanding.
The macro looks for xls files in a path, if there are no xls files in that path, it just doesn't open any files.
Maybe someone else can help you, I don't understand this:

file in the file path that isnt there

 

[jordanburch]

I'm not understanding.
The macro looks for xls files in a path, if there are no xls files in that path, it just doesn't open any files.
Maybe someone else can help you, I don't understand this:

ok so i simplified it quite a bit. I took all the files and transferred them to one folder on my desktop. Here is the code below. The only issue is the file names are different and I just want it to loop through and see if there is a tab called cleared - cleared to and if so import the data and then move to the next file. Can you please help?

The part where it says myfile is where the issue is I believe.

Jordan

Sub cert()
Dim myfile As String
Dim myfile2 As String
Dim erow As Long
Dim filepath As String
Dim filepath2 As String
Dim wb1 As Workbook, wb2 As Workbook



Dim ShtName1 As String
Dim ShtName2 As String
Dim ShtName3 As String
ShtName1 = "Cleared - Cleared to"
ShtName2 = "Detail"
ShtName3 = "Detail -"


Application.ScreenUpdating = False

Set wb1 = ThisWorkbook

filepath = "C:\Users\jordan.burch.ctr\Desktop\Cert Statements\"

myfile = ".xls*"

Dim strFileName As String
Dim strFileExists As String

strFileName = filepath & myfile
strFileExists = Dir(strFileName)

If strFileExists = "" Then
MsgBox "The file does not exist"

Else
erow = wb1.Sheets("Cleared - Cleared to").Cells(Rows.Count, 14).End(xlUp).Offset(1, 0).Row
Set wb2 = Workbooks.Open(filepath & myfile)
With wb2

Sheets("Cleared - Cleared to").Select
With ActiveSheet
If .AutoFilterMode Then
If .FilterMode Then
.ShowAllData
End If
Else
If .FilterMode Then
.ShowAllData
End If
End If
End With
Dim ShtName As String
ShtName = "Cleared - Cleared to"
If Evaluate("isref('" & ShtName & "'!A1)") Then
'sheet exists do something
Else
'sheet doesn't exist do something else
End If
If Evaluate("isref('" & ShtName1 & "'!A1)") Then
wb2.Sheets("Detail Lines").Range("AV2:AV20000").Value = myfile
.Sheets("Detail Lines").Range("a2:av20000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)

.Close savechanges:=False
ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
.Sheets("Detail Lines").Range("c21000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
.Close savechanges:=False

ElseIf Evaluate("isref('" & ShtName2 & "'!A1)") Then
.Sheets("Detail Lines").Range("c21000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
.Close savechanges:=False

End If


End With
End If

Application.ScreenUpdating = True


Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

Seriously, I still don't understand what you need. But I think you are missing an asterisk

myfile = "*.xls*"