Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
277 views
in Technique[技术] by (71.8m points)

How to write program for excel VBA loop files in a folder and find specific text in cells and save the file in another folder if it match to condition

For example there are some files in folder, loop files in folder and it should search specific text in specified cells if text matches with cells file should save in specified path

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:Usersp_DivyankaDesktopDivyankaVendor MetricsUS"
    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:Usersp_DivyankaDesktopDivyankaVendor MetricsUSFY2018ING"
    ActiveWorkbook.SaveAs Filename:= _
        "C:Usersp_DivyankaDesktopDivyankaVendor MetricsUSFY2018INGUS_ING_Aged_Detail.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Else
    ActiveWindow.Close
    End If
    End Sub}}}}
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

This is VBS so is paste able into 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:ackup"
        End If
    Next

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...