• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Run macro on files that has certain phrase in filename & certain value in cell

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
 
You have to open the workbook to check it's A1 value.

And since you can have another sheet active, specify workbook & sheet that house cell A1 that you are checking. Otherwise, code will likely return unexpected result, or cause error.
 
Thanks for your tip. The above code basically is a file re-namer that changes the file name by using certain cell value from that workbook. I used ExecuteExcel4Macro to retrieve value from the close workbook.

However, I have no idea how to pull value from a close workbook and then check if the value is 1.
 
Back
Top