如果文件名包含特定文本，则执行
我有代码循环通过一个文件夹，并将文本值添加到G1，H1，I1等等的工作簿。
在图1中，您可以看到我的文件夹中有多个文件。 不同的Excel文件或工作簿会获得不同的文本值添加到他们。
要添加到“Professional”工作簿的文本值与要添加到“ProfessionalAddress”或“ProfessionalCommunication”的文本值不同。
我试图使用InStr但是这将采取任何文件名包含某一段文字。
例如，我有几个包含单词“Professional”的文件，这意味着代码会将“Professional”文件的文本值添加到包含文本“Professional”的所有文件中。
我需要当一个文件名包含“专业”添加这些文本值，当一个文件包含“职业地址”添加这些文本值。 同样的“会议”“组织”“客户”。
图1 
Sub LoopAllExcelFilesInFolder() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'SOURCE: www.TheSpreadsheetGuru.com Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xls*" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) 'Loop through each Excel file in folder Do While myFile <> "" 'Set variable equal to opened workbook Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Ensure Workbook has opened before moving on to next line of code DoEvents If InStr(myFile, "Professional") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "ProfessionalId" Range("J1").Value = "StatusCode" Range("K1").Value = "ProfessionalTypeCode" Range("L1").Value = "StatusDate" Range("M1").Value = "Qualification" Range("N1").Value = "ProfessionalSubtypeCode" Range("O1").Value = "FirstName" Range("P1").Value = "MiddleName" Range("Q1").Value = "LastName" Range("R1").Value = "SecondLastName" Range("S1").Value = "MeNumber" Range("T1").Value = "ImsPrescriberId" Range("U1").Value = "NdcNumber" Range("V1").Value = "TitleCode" Range("W1").Value = "ProfessionalSuffixCode" Range("X1").Value = "GenderCode" Range("Y1").Value = "Reserved for future use" Range("Z1").Value = "Reserved for future use" Range("AA1").Value = "Reserved for future use" Range("AB1").Value = "Reserved for future use" Range("AC1").Value = "SourceDataLevelCode" Range("AD1").Value = "PatientsPerDay" Range("AE1").Value = "PrimarySpecialtyCode" Range("AF1").Value = "SecondarySpecialtyCode" Range("AG1").Value = "TertiarySpecialtyCode" Range("AH1").Value = "NationalityCode" Range("AI1").Value = "TypeOfStudy" Range("AJ1").Value = "UniversityAffiliation" Range("AK1").Value = "SpeakerStatusCode" Range("AL1").Value = "OneKeyId" Range("AM1").Value = "NucleusId" Range("AN1").Value = "Suffix" Range("AO1").Value = "ClientField1" Range("AP1").Value = "ClientField2" Range("AQ1").Value = "ClientField3" Range("AR1").Value = "ClientField4" Range("AS1").Value = "ClientField5" Range("AT1").Value = "Reserved for future use" Range("AU1").Value = "NPICountry" Range("AV1").Value = "CountryCode" Range("AW1").Value = "Reserved for future use" Range("AX1").Value = "MassachusettsId" Range("AY1").Value = "NPIId" Range("AZ1").Value = "UniversityCity" Range("BA1").Value = "UniversityPostalArea" End If If InStr(myFile, "ProfessionalAddress") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "ProfessionalAddressId" Range("J1").Value = "EffectiveDate" Range("K1").Value = "StatusCode" Range("L1").Value = "ProfessionalId" Range("M1").Value = "AddressTypeCode" Range("N1").Value = "StatusDate" Range("O1").Value = "Reserved for future use" Range("P1").Value = "AddressLine1" Range("Q1").Value = "AddressLine2" Range("R1").Value = "AddressLine3" Range("S1").Value = "City" Range("T1").Value = "State" Range("U1").Value = "PostalArea" Range("V1").Value = "PostalAreaExtension" Range("W1").Value = "CountryCode" Range("X1").Value = "Reserved for future use" Range("Y1").Value = "Reserved for future use" Range("Z1").Value = "Reserved for future use" Range("AA1").Value = "DeaNumber" Range("AB1").Value = "DeaExpirationDate" Range("AC1").Value = "LocationName" Range("AD1").Value = "EndDate" Range("AE1").Value = "N/A" End If If InStr(myFile, "ProfessionalStateLicense") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "ProfessionalLicenseId" Range("J1").Value = "EffectiveDate" Range("K1").Value = "EndDate" Range("L1").Value = "ProfessionalId" Range("M1").Value = "StateLicenseNumber" Range("N1").Value = "StateLicenseState" Range("O1").Value = "StateLicenseExpirationDate" Range("P1").Value = "SamplingStatusCode" Range("Q1").Value = "Reserved for future use" Range("R1").Value = "N/A" End If If InStr(myFile, "ProfessionalCommunication") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "ProfessionalCommunicationId" Range("J1").Value = "ProfessionalId" Range("K1").Value = "CommunicationTypeCode" Range("L1").Value = "CommunicationValue1" Range("M1").Value = "CommunicationValue2" Range("N1").Value = "ProfessionalAddressId" Range("O1").Value = "N/A" End If If InStr(myFile, "Organization") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "OrganizationId" Range("J1").Value = "StatusCode" Range("K1").Value = "OrganizationTypeCode" Range("L1").Value = "StatusDate" Range("M1").Value = "Reserved for future use" Range("N1").Value = "OrganizationSubtypeCode" Range("O1").Value = "OrganizationName" Range("P1").Value = "NPICountry" Range("Q1").Value = "Reserved for future use" Range("R1").Value = "Reserved for future use" Range("S1").Value = "Reserved for future use" Range("T1").Value = "Reserved for future use" Range("U1").Value = "SourceDataLevelCode" Range("V1").Value = "Reserved for future use" Range("W1").Value = "Reserved for future use" Range("X1").Value = "OneKeyId" Range("Y1").Value = "FederalTaxId" Range("Z1").Value = "Reserved for future use" Range("AA1").Value = "NucleusId" Range("AB1").Value = "Reserved for future use" Range("AC1").Value = "ClientField1" Range("AD1").Value = "ClientField2" Range("AE1").Value = "ClientField3" Range("AF1").Value = "ClientField4" Range("AG1").Value = "ClientField5" Range("AH1").Value = "MassachusettsId" Range("AI1").Value = "NPIId" Range("AJ1").Value = "N/A" End If If InStr(myFile, "OrganizationAddress") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "OrganizationAddressId" Range("J1").Value = "EffectiveDate" Range("K1").Value = "StatusCode" Range("L1").Value = "OrganizationId" Range("M1").Value = "AddressTypeCode" Range("N1").Value = "StatusDate" Range("O1").Value = "Reserved for future use" Range("P1").Value = "AddressLine1" Range("Q1").Value = "AddressLine2" Range("R1").Value = "AddressLine3" Range("S1").Value = "City" Range("T1").Value = "State" Range("U1").Value = "PostalArea" Range("V1").Value = "PostalAreaExtension" Range("W1").Value = "CountryCode" Range("X1").Value = "Reserved for future use" Range("Y1").Value = "Reserved for future use" Range("Z1").Value = "Reserved for future use" Range("AA1").Value = "DeaNumber" Range("AB1").Value = "DeaExpirationDate" Range("AC1").Value = "LocationName" Range("AD1").Value = "EndDate" Range("AE1").Value = "N/A" End If If InStr(myFile, "OrganizationCommunication") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "OrganizationCommunicationId" Range("J1").Value = "OrganizationId" Range("K1").Value = "CommunicationTypeCode" Range("L1").Value = "CommunicationValue1" Range("M1").Value = "CommunicationValue2" Range("N1").Value = "OrganizationAddressId" Range("O1").Value = "N/A" End If If InStr(myFile, "OrganizationSpecialty") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "OrganizationSpecialtyId" Range("J1").Value = "OrganizationId" Range("K1").Value = "SpecialtyTypeCode" Range("L1").Value = "SpecialtyCode" Range("M1").Value = "N/A" End If If InStr(myFile, "Agreement01_MSD") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "AgreementId" Range("J1").Value = "CompanyId" Range("K1").Value = "AgreementName" Range("L1").Value = "AgreementType" Range("M1").Value = "StatusCode" Range("N1").Value = "Description" Range("O1").Value = "AgreementDate" Range("P1").Value = "CustomerId" Range("Q1").Value = "ApprovalDate" Range("R1").Value = "StartDate" Range("S1").Value = "EndDate" Range("T1").Value = "SignatureDate" Range("U1").Value = "SecondaryCustomerId" Range("V1").Value = "AgreementCountry" Range("W1").Value = "ClientField1" Range("X1").Value = "ClientField2" Range("Y1").Value = "ClientField3" Range("Z1").Value = "ClientField4" Range("AA1").Value = "ClientField5" Range("AB1").Value = "ClientDate1" Range("AC1").Value = "ClientDate2" Range("AD1").Value = "ClientNumber1" Range("AE1").Value = "ClientNumber2" Range("AF1").Value = "DataSourceId" Range("AG1").Value = "CreationUser" Range("AH1").Value = "CommentText" Range("AI1").Value = "FirstName" Range("AJ1").Value = "MiddleName" Range("AK1").Value = "LastName" Range("AL1").Value = "AddressId" Range("AM1").Value = "AddressLine1" Range("AN1").Value = "AddressLine2" Range("AO1").Value = "AddressLine3" Range("AP1").Value = "City" Range("AQ1").Value = "State" Range("AR1").Value = "PostalArea" Range("AS1").Value = "Country" Range("AT1").Value = "SecondaryFirstName" Range("AU1").Value = "SecondaryMiddleName" Range("AV1").Value = "SecondaryLastName" Range("AW1").Value = "SecondaryAddressId" Range("AX1").Value = "SecondaryAddressLine1" Range("AY1").Value = "SecondaryAddressLine2" Range("AZ1").Value = "SecondaryAddressLine3" Range("BA1").Value = "SecondaryCity" Range("BB1").Value = "SecondaryState" Range("BC1").Value = "SecondaryPostalArea" Range("BD1").Value = "SecondaryCountry" Range("BE1").Value = "EventVenue" Range("BG1").Value = "EventName" Range("BG1").Value = "EventDate" Range("BH1").Value = "AgreementVenueOrganizer" Range("BI1").Value = "AgreementReason" End If If InStr(myFile, "Consent11_MSD") > 0 Then 'Add Column Headings wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "ConsentId" Range("J1").Value = "CompanyId" Range("K1").Value = "ConsentType" Range("L1").Value = "ConsentIndicator" Range("M1").Value = "CustomerId" Range("N1").Value = "ExpensePurposeCode" Range("O1").Value = "EffectiveDate" Range("P1").Value = "EndDate" Range("Q1").Value = "ConsentDate" Range("R1").Value = "CommentText" Range("S1").Value = "AgreementId" Range("T1").Value = "CustomerExpenseId" Range("U1").Value = "MeetingId" Range("V1").Value = "DataSourceId" Range("W1").Value = "ClientField1" Range("X1").Value = "ClientField2" Range("Y1").Value = "ClientField3" Range("Z1").Value = "ClientField4" Range("AA1").Value = "ClientField5" Range("AB1").Value = "N/A" End If 'Save and Close Workbook wb.Close SaveChanges:=True 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub
剥下代码进行testing
Sub LoopAllExcelFilesInFolder() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'SOURCE: www.TheSpreadsheetGuru.com Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xls*" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) 'Loop through each Excel file in folder Do While myFile <> "" 'Set variable equal to opened workbook Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Ensure Workbook has opened before moving on to next line of code DoEvents myFile = "20170614Agreement01_MSD.xls" If getTextBtwnNumbers(myFile) = "Agreement" Then 'Add Text wb.Worksheets(1).Range("F1").Value = "Error code" Range("G1").Value = "Error description" Range("H1").Value = "ActionCode" Range("I1").Value = "ProfessionalId" Range("J1").Value = "StatusCode" Range("K1").Value = "ProfessionalTypeCode" Range("L1").Value = "StatusDate" Range("M1").Value = "Qualification" 'etc etc etc End If 'Save and Close Workbook wb.Close SaveChanges:=True 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Private Function getTextBtwnNumbers(s As String) As String Dim pos1 As Long, pos2 As Long Dim i As Long, j As Long For i = 1 To Len(s) If pos1 = 0 Then Select Case Asc(Mid(s, i, 1)) Case 65 To 90, 97 To 122 pos1 = i End Select Else For j = pos1 To Len(s) Select Case Asc(Mid(s, j, 1)) Case 65 To 90, 97 To 122 Case Else pos2 = j ' - 1 Exit For End Select Next j End If If pos1 <> 0 And pos2 <> 0 Then Exit For Next i If pos1 <> 0 And pos2 <> 0 Then getTextBtwnNumbers = Trim(Mid(s, pos1, pos2 - pos1)) Else getTextBtwnNumbers = "Invalid Text Format" End If End Function
问题是文件名中没有空格。 在这种情况下，防止误报变得困难。
话虽如此，如果您正在寻找的文本将始终在2个数字之间; 例如Agreement在20170614和01之间20170614 ，那么我们可以采取这种方法
将此函数添加到您的代码
Private Function getTextBtwnNumbers(s As String) As String Dim pos1 As Long, pos2 As Long Dim i As Long, j As Long For i = 1 To Len(s) If pos1 = 0 Then Select Case Asc(Mid(s, i, 1)) Case 65 To 90, 97 To 122 pos1 = i End Select Else For j = pos1 To Len(s) Select Case Asc(Mid(s, j, 1)) Case 65 To 90, 97 To 122 Case Else pos2 = j ' - 1 Exit For End Select Next j End If If pos1 <> 0 And pos2 <> 0 Then Exit For Next i If pos1 <> 0 And pos2 <> 0 Then getTextBtwnNumbers = Trim(Mid(s, pos1, pos2 - pos1)) Else getTextBtwnNumbers = "Invalid Text Format" End If End Function
然后你可以像这样使用它
Sub Sample() Dim flName As String flName = "20170614Agreement01_MSD.xls" If getTextBtwnNumbers(flName) = "Agreement" Then MsgBox "Match Found" End If End Sub
注意：
我假设文本将在NumberTEXTNumber格式的2个数字之间。
如果你有一个NumberTEXTONENumberTEXTTWONumber的格式，那么这个函数只会提取TEXTONE
编辑
我意识到使用LIKE有更好的方法。 这样你就不需要上述的function。
Sub Sample() Dim flName As String, Searchtext As String flName = "20170614Agreement01_MSD.xls" Searchtext = "Agreement" If flName Like "*#" & Searchtext & "#*.xls" Then MsgBox "Match Found" End Sub
我build议你在“If”语句中使用“And”来对文件名进行更复杂的检查。
顺便说一句，如果你想让你的“InStr”函数检查一个小string是否存在于一个更大的string中，你只需要这样做：
If InStr(myFile, "Professional") Then
而不是这个：
If InStr(myFile, "Professional") > 0 Then
这就好像在If … Then语句中返回“True”或“False”。
这是我对你的问题的解决scheme：
Public Sub testStr() Dim strVar As String Dim myFile As String myFile = "ProfessionalStateLicense" If InStr(myFile, "Professional") And InStr(myFile, "StateLicense") Then MsgBox myFile ' do specific case End If End Sub
只需将“StateLicense”replace为文件夹中文件名的其他子文本示例即可。 例如，将“StateLicense”replace为“Address”。
可能还有一种方法可以使用“Select Case”方法，但我相信这需要比我的解决scheme更多的工作。