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