VBA Word Do While Loop Not Opening Files Based On If Criteria With Wildcards

Question

I have this code below for Word VBA. What it is supposed to do is pull up the file folder dialog then open all the files in the directory then if the file name contains the product's name then it will apply a formating header that add a logo and changes the date.

Everything works fine except within the Do While Loop, the If statement for the product name criteria isn't picking up any of the files.

I need to only apply the header to documents with LegobuildingTower, but there are multiple product names in the folder.

That's why I needed use the wildcard If nFile like "LegobuildingTower" then continue with the Do loop because the filename could be 123145234_LegobuildingTower or LegobuildingTowerBlue.

Sorry, I'm fairly new to VBA so if there is a better way to do this let me know especially since I think there is a way to probably use an array, but I'm not too familiar with using Arrays in VBA yet. Thanks.

Option Explicit

Dim vDirectory As String
Dim oDoc As Document
Dim strFolderPath As String
Dim cmdSelectInput As String
Dim vFile As String
Dim vFileName As String
Dim nFile As String
Dim intPos As Integer
Dim inputData As String

Sub PA_STFormat()

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Location Directory"
    .ButtonName = "Open"
    If .Show = -1 Then
    cmdSelectInput = .SelectedItems.Item(1) & "\"
    Else
    MsgBox "Action Canceled"
    End If
End With

InputDate

vDirectory = cmdSelectInput
'InputBox("Enter the folder path to Documents", "File Conversion", "C:\Users\jlosaria\Documents\Source Files\PA & ST Rx Web Files\")


vFile = Dir(vDirectory & "*.doc*")
vFileName = vDirectory & Dir(vDirectory)
intPos = InStrRev(vFile, ".")
nFile = Left(vFile, intPos - 1)

Do While nFile <> ""

    If nFile Like "*Product1*" Or nFile Like "*Product2*" Or nFile Like "*Product3*" Or nFile Like "*Product4*" Or nFile Like "*Product5*" Or _
    nFile Like "*Product6*" Then

    Set oDoc = Documents.Open(FileName:=vDirectory & vFile)

    Call MRHeaderFormat 'A sub that formats the header
    ActiveDocument.SaveAs2 FileName:=nFile & ".pdf", _
                           FileFormat:=wdFormatPDF, _
                           LockComments:=False, _
                           Password:="", _
                           AddToRecentFiles:=True, _
                           WritePassword:="", _
                           ReadOnlyRecommended:=False, _
                           EmbedTrueTypeFonts:=False, _
                           SaveNativePictureFormat:=False, _
                           SaveFormsData:=False, _
                           SaveAsAOCELetter:=False, _
                           Encoding:=1252, _
                           InsertLineBreaks:=True, _
                           AllowSubstitutions:=False, _
                           LineEnding:=wdCRLF, _
                           CompatibilityMode:=0

    oDoc.Close SaveChanges:=True
    ChangeFileOpenDirectory vDirectory
    vFile = Dir
    Else
    MsgBox "No more files found."
    Exit Do
    End If

Loop

MsgBox "Finished"

End Sub

Answer 1

Here is an example of using an array (split from a constant string of known products, but could also be split from a variable string).

Const PRODUCT_NAMES As String = "Product1,Product2,Product3,Product4,Product5,Product6,Product10"
Sub Test()

Debug.Print FileNameMatch("123lkd_Product1kdalf")           '<-- TRUE
Debug.Print FileNameMatch("Bob Smith Loves Product2")       '<-- TRUE
Debug.Print FileNameMatch("P_R_O_D_UC_T_6")                 '<-- FALSE
Debug.Print FileNameMatch("Product54_Revised_01-01-2014")   '<-- TRUE

End Sub

This calls on the function I created below. Basically this iterates each of the products from the list defined as PRODUCT_NAMES. Since you used OR operators, I simply tally the number of fuzzy matches in variable i, any value of i >= 1 means there was at least one condition that matched, so the function returns True. If there is no match, it returns false.

Function FileNameMatch(strName As String) As Boolean

Dim products() As String
Dim prod As Variant
Dim i As Integer

products = Split(PRODUCT_NAMES, ",")

For Each prod In products
    If strName Like "*" & prod & "*" Then i = i + 1
Next

'Alternatively, you could use INSTR instead of Like
'For each prod in products
'    If Instr(1, prod, strName) > 0 Then i = i + 1
'Next

FileNameMatch = (i >= 1)

End Function

Updated from comments

Sure, that would be one way to do it. Like,

If FileNameMatch("123kd_Product1_kdladfi") Then
    'Call your formatting function, here:

ElseIf AnotherMatchingFunction("123kd_Product1_kdladfi" Then
    'File name did not match the first list, but matches the second list
    'Call a different formatting function, here:

End If