Question

例如，文件夹中有一些文件，文件夹中有循环文件，如果文本与单元格文件匹配，则应在指定的路径中搜索特定的文本

This line am getting error"If Range("A6").Value = ("CORE SKUS ONLY: N").Value  & If Range("A7").Value =("ECO SKUS ONLY: Y").Value Then

{{{{Sub OpenLatestFile（）

    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim rFind As Range
    Dim strSearch As String
    strSearch = "CORE SKUS ONLY"

    Dim LMD As Date
MyPath = "C:\Users\p_Divyanka\Desktop\Divyanka\Vendor Metrics\US"
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    MyFile = Dir(MyPath & "RptLineItemFillRate_*.xls", vbNormal)
    If Len(MyFile) = 0 Then
     MsgBox "No files were found...", vbExclamation
     Exit Sub
End If

Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop
Workbooks.Open MyPath & LatestFile
Windows("RptLineItemFillRate_*.xls").Activate
ActiveWindow
    If Range("A6").Value = ("CORE SKUS ONLY: N").Value  & If Range("A7").Value =("ECO SKUS ONLY: Y").Value Then
    Windows("RptLineItemFillRate_*.xls").Activate
    ChDir "C:\Users\p_Divyanka\Desktop\Divyanka\Vendor Metrics\US\FY2018\ING"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\p_Divyanka\Desktop\Divyanka\Vendor Metrics\US\FY2018\ING\US_ING_Aged_Detail.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Else
    ActiveWindow.Close
    End If
    End Sub}}}}

Answer 1

这是VBS，因此可以粘贴到VBA。

'Remove next line in VBA
Main

Sub Main
    'On Error Resume Next
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dirname = InputBox("Enter Dir name (don't use quotes)")
    Searchterm = Inputbox("Enter search term")
    ProcessFolder DirName
End Sub

Sub ProcessFolder(FolderPath)
'   On Error Resume Next
    Set fldr = fso.GetFolder(FolderPath)
    Set Fls = fldr.files
    For Each thing in Fls
            If Instr(LCase(thing.OpenAsTextStream.ReadAll), LCase(SearchTerm)) > 0 then
            msgbox Thing.Name & " " & Thing.path 
            'fso.copyfile thing.path, "C:\backup"
        End If
    Next

    Set fldrs = fldr.subfolders
    For Each thing in fldrs
        ProcessFolder thing.path
    Next
End Sub

如何在文件夹中为excel VBA循环文件编写程序，并在单元格中查找特定文本，并在符合条件的情况下将文件保存在另一个文件夹中

1 个答案: