Tema: Re: VBA search through file content
Autorius: CurrentUser
Data: 2019-12-18 14:59:44
Super!
Bet vis vien tiem, kurie tanke nesigauna iki galo damušti. Problemos dvi:
1) Failo Properties "Tag" įrašo nesimato, nors ir debuginant išveda;
2) Nesuprantu  kur neuždaro Excelio? T.prasme background'e jis lieka 
atviras, t.y. norint atidaryti tikrinamą failą, rodo, kad jis yra atvertas. 
Kodas:

Sub LoopAllFilesInFolder()

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("D:\AAA\")
Set Files = folder.Files

Set xl = CreateObject("Excel.Application")

Set re = CreateObject("VBScript.RegExp")
re.Pattern = "xls?"
re.IgnoreCase = True

For Each f In Files
    If (re.Test(fso.GetExtensionName(f.Name))) Then
        Set xlwb = xl.Workbooks.Open(f.Path)
        If xlwb.Worksheets(1).Range("C3") = "aaaa" Then
            xlwb.BuiltinDocumentProperties("Keywords").Value = "AA"
            xl.DisplayAlerts = False
            xlwb.Saved = True
            xlwb.Close
        End If
    Else
    End If
Next

Set fso = Nothing
Set folder = Nothing
Set Files = Nothing
xl.Quit

End Sub



wrote in message news:qtbfoe$dg3$1@news.omnitel.net...

CurrentUser rašė:
> Hi,
>
> Reikia pertikrinti >1K failu (visi xls) ir jei jo celeje (C3) yra
> tekstas "aaaa", ta faila reikia pazymeti, tarkim Tag="AA"
> Turim toki koda:
> <...>
> Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
> Set FSOFolder = FSOLibrary.GetFolder(folderName)
> Set FSOFile = FSOFolder.Files
>
> 'Use For Each loop to loop through each file in the folder
> For Each FSOFile In FSOFile
>
> 'Va cia nzn kaip nurodyti, kad failas - xl'inis ir jam taikomi Excelio
> atributai:
>    If FSOFile.Worksheets("Sheet1").Range("C3") = "aaaa" Then


Jei VBA leidi jau pačiame Excel'yje, tai radęs xls failą pirma jį
atsidaryk su Workbook.Open(), o tada jau tikrink turinį.

VBScript būtų taip:

Set excel = CreateObject("Excel.Application")

Set re = CreateObject("VBScript.RegExp")
re.Pattern = "xlsx?"
re.IgnoreCase = True

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(".")
Set files = folder.Files

For Each f in files
    if (re.Test(fso.GetExtensionName(f.Name))) then

Set xlwb = excel.Workbooks.Open(f.Path)
If xlwb.Worksheets(1).Range("C3") = "aaaa" then
            xlwb.BuiltinDocumentProperties("Keywords").Value = "AA"
End If
xlwb.Close()
    end if
Next