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










3Dastronomyagricultureaudioautosautos.audiautos.audioautos.binariesautos.bmwautos.clubautos.fordautos.hondacrxautos.japanautos.mercedesautos.opelautos.sportautos.volvoautos.vwaviaavia.binariesbankcardsbinariesbooksbuildingcinemacommercecomp.hardwarecomp.softwarecomp.lietuvinimascomp.networksculturedarbas.ieskaudarbas.siulaudesigneconomicselectronicsfaunafauna.aquafauna.binariesfishingflorafotofoto.binariesgamesgames.csgames.onlinegsmgurmanaihumourhumour.binariesinternetlawmicrosoftmotomusicmusic.binariesmusic.instrumentsmusic.LT.binariesnavigacijaphppoliticsprogrammingrpgsportstudyingsveikatatalktesttranslationtransportationtraveltravel.binariestvunixvideovideo.binarieswatersportswwwwww.flashpdaautos.supermama.ltmobiledarbasretro.3Dretro.agricultureretro.astronomyretro.audioretro.autosretro.autos.audiretro.autos.audioretro.autos.binariesretro.autos.bmwretro.autos.clubretro.autos.fordretro.autos.hondacrxretro.autos.japanretro.autos.mercedesretro.autos.opelretro.autos.sportretro.autos.supermamaretro.autos.supermama.ltretro.autos.volvoretro.autos.vwretro.aviaretro.avia.binariesretro.bankcardsretro.beosretro.binariesretro.booksretro.buildingretro.cinemaretro.commerceretro.compretro.comp.hardwareretro.comp.lietuvinimasretro.comp.networksretro.comp.softwareretro.cultureretro.darbasretro.darbas.ieskauretro.darbas.siulauretro.designretro.economicsretro.electronicsretro.e-vejasretro.faunaretro.fauna.aquaretro.fauna.binariesretro.fishingretro.floraretro.fotoretro.foto.binariesretro.gamesretro.games.csretro.games.onlineretro.games.rpgretro.genealogijaretro.gsmretro.gurmanairetro.humourretro.humour.binariesretro.internetretro.YZFretro.YZF.nebukretro.YZF.nebuk.netikintisretro.YZF.nebuk.netikintis.bukretro.YZF.nebuk.netikintis.buk.tikintisretro.lawretro.microsoftretro.mobileretro.motoretro.musicretro.music.binariesretro.music.instrumentsretro.music.LTretro.music.LT.binariesretro.navigacijaretro.newsretro.news.taisyklesretro.newuserretro.pdaretro.phpretro.politicsretro.programmingretro.rpgretro.sportretro.studyingretro.sveikataretro.talkretro.translationretro.transportationretro.travelretro.travel.binariesretro.tvretro.unixretro.videoretro.video.binariesretro.watersportsretro.wwwretro.www.flashdiylt.rkm.news.announcelt.rkm.news.newuser