Winston618
Member
I would like to write a VBA to check the files in a folder that contains a certain phrase (say ABC) in filename and has a certain value in cell A1 (like 1) in sheet1. I can get the first part (contains a certain phrase ) working but fail on adding the second criteria (checking the cell value). No error is prompt, code ends with nothing happens. Please help, thank you so much.
Code:
Sub Daily_Working()
Dim myDir As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then myDir = .SelectedItems(1)
End With
If myDir = vbNullString Then Exit Sub
Application.ScreenUpdating = False
'find files name contain A
'ReNameFiles_A_ myDir
Application.ScreenUpdating = True
End Sub
Code:
Sub ReNameFiles_A_(ByVal myDir As String)
Dim sfo As Object, MyFile As Object, myFolder As Object, temp As String, newName, i As Long
Set sfo = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each MyFile In sfo.GetFolder(myDir).Files
If MyFile.Name Like "*ABC*" Then
'If ActiveSheet.Range("A1").Value = "1" Then 'this part doesn't work
For i = 4 To 5
newName = ExecuteExcel4Macro("right(substitute('" & myDir & "\[" & MyFile.Name & "]sheet1'!r" & i & "c1,""/"",""""),8)")
If (Not IsError(newName)) Then
If (newName <> vbNullString) * (IsNumeric(newName)) Then Exit For
End If
Next
If IsError(newName) Then newName = GetDate(myDir & "\" & MyFile.Name)
If newName <> "" Then
newName = Replace(newName, "/", "")
' temp = Left$(sfo.GetBaseName(MyFile.Name), 10) & newName & _
"." & sfo.GetExtensionName(MyFile.Name)
temp = newName & " " & Left$(sfo.GetBaseName(MyFile.Name), 10) & _
"." & sfo.GetExtensionName(MyFile.Name)
Name myDir & "\" & MyFile.Name As myDir & "\" & temp
End If
'End If
newName = ""
End If
Next
For Each myFolder In sfo.GetFolder(myDir).subfolders
ReNameFiles_A_ myFolder.Path
Next
End Sub