VBA Word Do While循环不基于带通配符的If条件打开文件

VBA Word Do While循环不基于带通配符的If条件打开文件,vba,if-statement,ms-word,do-while,Vba,If Statement,Ms Word,Do While,我有下面的代码用于Word VBA。它应该做的是打开文件夹对话框,然后打开目录中的所有文件,如果文件名包含产品名称,那么它将应用一个格式化头,添加徽标并更改日期 除了Do-While循环外,其他一切都正常工作,产品名称条件的If语句不会拾取任何文件 我只需要将标题应用于使用LegobuildingTower的文档,但文件夹中有多个产品名称 这就是为什么我需要使用通配符,如果文件名像“LegobuildingTower”,则继续执行Do循环,因为文件名可能是123145234_Legobuildi

我有下面的代码用于Word VBA。它应该做的是打开文件夹对话框,然后打开目录中的所有文件,如果文件名包含产品名称,那么它将应用一个格式化头,添加徽标并更改日期

除了Do-While循环外,其他一切都正常工作,产品名称条件的If语句不会拾取任何文件

我只需要将标题应用于使用LegobuildingTower的文档,但文件夹中有多个产品名称

这就是为什么我需要使用通配符,如果文件名像“LegobuildingTower”,则继续执行Do循环,因为文件名可能是123145234_LegobuildingTower或LegobuildingTowerBlue

对不起,我是VBA新手,如果有更好的方法,请让我知道,特别是因为我认为有一种方法可以使用数组,但我还不太熟悉在VBA中使用数组。谢谢

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
选项显式
Dim vDirectory作为字符串
作为文档的Dim-oDoc
将strFolderPath设置为字符串
Dim cmdSelectInput作为字符串
将vFile设置为字符串
将vFileName设置为字符串
将文件变暗为字符串
作为整数的Dim intPos
将输入数据设置为字符串
子PA_STFormat()
使用Application.FileDialog(msoFileDialogFolderPicker)
.Title=“选择位置目录”
.ButtonName=“打开”
如果.Show=-1,则
cmdSelectInput=.SelectedItems.Item(1)和“\”
其他的
MsgBox“操作已取消”
如果结束
以
输入日期
vDirectory=cmdSelectInput
'输入框(“输入文档的文件夹路径”,“文件转换”,“C:\Users\jlosaria\Documents\Source Files\PA&ST Rx Web Files\”)
vFile=Dir(vDirectory&“*.doc*”)
vFileName=vDirectory&Dir(vDirectory)
intPos=InStrRev(vFile,“.”)
n文件=左(vFile,intPos-1)
当文件“”时执行此操作
如果类似于“*Product1*”或类似于“*Product2*”或类似于“*Product3*”或类似于“*Product4*”或类似于“*Product5*”的文件,或_
n文件像“*Product6*”那么
设置oDoc=Documents.Open(文件名:=vDirectory&vFile)
将MRHeaderFormat称为“格式化标题的子项”
ActiveDocument.SaveAs2文件名:=nFile&“.pdf”_
文件格式:=wdFormatPDF_
注释:=假_
密码:=“”_
AddToRecentFiles:=True_
WritePassword:=“”_
ReadOnlyRecommended:=False_
EmbeddeTrueTypeFonts:=False_
SaveNativePictureFormat:=False_
SaveFormsData:=False_
saveAsoceLetter:=False_
编码:=1252_
InsertLineBreaks:=真_
AllowSubstitutions:=False_
行尾:=wdCRLF_
相容性模式:=0
oDoc.Close SaveChanges:=真
ChangeFileOpenDirectory vDirectory
vFile=Dir
其他的
MsgBox“找不到更多文件。”
退出Do
如果结束
环
MsgBox“已完成”
端接头

这里是一个使用数组的示例(从已知产品的常量字符串中拆分,但也可以从变量字符串中拆分)

根据评论更新

当然,这是一种方法。像

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

您正在进行字符串比较(nFile和“ProductX”),因此请使用字符串比较函数。InStr是一款立即浮现在脑海中的产品。它工作得非常完美!非常感谢。我有一个问题。我需要创建另一个数组,为那些与初始列表中的产品不匹配的产品应用不同类型的格式更改。最简单的过程是为所有不匹配项创建一个新函数和新列表,然后执行else-if语句来调用新函数吗?是的,您可以这样做,请参见上面的修订。
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
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