vbs - indexering van bestanden

[erigor]

Hallo Helpmij.nl leden!

Ik ben bezig met een VBS script
Om een index te maken van alle bestanden die in een bepaalde map staan.
Op basis van de bestandlocatie gaat het script de volgende gegevens in een excel bestand plaatsen.

1. de volgnummer
2. groep waar document toe behoort
3. type document zelf
4. geeft jaargang weer.
5. naam van document, dat dan ook gelinkt is naar de locatie.

vb document staat op F:\DATA\archief\Data\water\factuur\fa-12-2012-water.pdf output in excel is ongeveer zo:

1 | Water | factuur | 2012 | fa-12-2012-water.pdf

Nu mijn vraag:

Naar mijn mening moet de het script eenvoudiger kunnen.
Zeker voor de bovenvermelde punten 2, 3 en 4
Dit is eigenlijk 3x dezelfde code en hoe meer onderverdelingen er gaan zijn, hoe langer de code.


in plaats van de volgende code:

If InStr (1,strMatch, strauto, 1) > 0 Then
objExcel.Cells(intRow, 2).Value = strauto

ElseIf InStr (1,strMatch, strelectriciteit, 1) > 0 Then
objExcel.Cells(intRow, 2).Value = strelectriciteit

ElseIf InStr (1,strMatch, strwater, 1) > 0 Then
objExcel.Cells(intRow, 2).Value = strwater


ElseIF InStr (1,strMatch, strwerk, 1) > 0 Then
objExcel.Cells(intRow, 2).Value = strwerk

End If

iets, maar weet niet goed hoe...

een array waar al de onderverdelingen instaan (eenvoudiger om te schalen)

iets als :
Array("auto","electriciteit","werk","water")

als 1 van de woorden in array overeenkomt met "strmatch" (strMatch = Subfolder.Path = F:\DATA\archief\Data\water\factuur\) (omdat het een mapstructuur is kan het maar 1x voorkomen, het woord "DATA" is hier een uitzondering maar moet nergens ingevuld worden)

objExcel.Cells(intRow, 2).Value = overeenkomstig woord uit array


Kan iemand mij hierbij helpen?

Hieronder kan u het volledige script terugvinden

alvast bedankt om een kijkje te willen nemen

Erigor

Option Explicit

'declaratie en gekoppelde waarden
' deel 1
Dim objStartFolder, objExcel, intRow, objFSO, objFolder, colFiles, objFile, Subfolder, strMatch

' deel 2
Dim counter

counter = 1

' deel 3
Dim strauto, strelectriciteit, strwater, strwerk

strauto = "auto"
strelectriciteit = "electriciteit"
strwater = "water"
strwerk = "werk"

' deel 4
Dim strloonfiche, strcontract, strfactuur, strinfo

strloonfiche = "loonfiche"
strcontract = "contract"
strfactuur = "factuur"
strinfo = "info"

' deel 5
Dim strY00, strY01, strY02, strY03, strY04, strY05, strY06, strY07, strY08, strY09, strY10, strY11, strY12, strY13, strY14, strY15

strY00 = "2000"
strY01 = "2001"
strY02 = "2002"
strY03 = "2003"
strY04 = "2004"
strY05 = "2005"
strY06 = "2006"
strY07 = "2007"
strY08 = "2008"
strY09 = "2009"
strY10 = "2010"
strY11 = "2011"
strY12 = "2012"
strY13 = "2013"
strY14 = "2014"
strY15 = "2015"

' deel 1
' locatie van bestand hier ingeven
objStartFolder = "F:\DATA\archief\Data"

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Open "F:\DATA\archief\MAIN.xlsx"

' op rij 2 beginnen, als deze op 1 staat gaar de pivot in de bestaande exel gewist worden
intRow = 2

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(objStartFolder)

Set colFiles = objFolder.Files
For Each objFile in colFiles

intRow = intRow + 1
Next

ShowSubfolders objFSO.GetFolder(objStartFolder)

Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders

Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
strMatch = Subfolder.Path

' ----------------------------------------------------------------
' Deel 2: kolom A, counter (ID weergeven)
objExcel.Cells(intRow, 1).Value = counter
counter = counter +1

' ----------------------------------------------------------------
' Deel 3: kolom B, Match document group (Groep weergeven)
If InStr (1,strMatch, strauto, 1) > 0 Then
objExcel.Cells(intRow, 2).Value = strauto

ElseIf InStr (1,strMatch, strelectriciteit, 1) > 0 Then
objExcel.Cells(intRow, 2).Value = strelectriciteit

ElseIf InStr (1,strMatch, strwater, 1) > 0 Then
objExcel.Cells(intRow, 2).Value = strwater


ElseIF InStr (1,strMatch, strwerk, 1) > 0 Then
objExcel.Cells(intRow, 2).Value = strwerk

'ElseIF InStr (1,strMatch, , 1) > 0 Then
' objExcel.Cells(intRow, 2).Value =

End If

' ----------------------------------------------------------------
' Deel 4: kolom C, Match document type (Document weergeven)
If InStr (1,strMatch, strloonfiche, 1) > 0 Then
objExcel.Cells(intRow, 3).Value = strloonfiche


ElseIf InStr (1,strMatch, strcontract, 1) > 0 Then
objExcel.Cells(intRow, 3).Value = strcontract

ElseIf InStr (1,strMatch, strfactuur, 1) > 0 Then
objExcel.Cells(intRow, 3).Value = strfactuur


ElseIF InStr (1,strMatch, strinfo, 1) > 0 Then
objExcel.Cells(intRow, 3).Value = strinfo

End If

' ----------------------------------------------------------------
' Deel 5: kolom D, Match Year (Jaar weergeven)
If InStr (1,strMatch, strY00, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY00

ElseIf InStr (1,strMatch, strY01, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY01

ElseIf InStr (1,strMatch, strY02, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY02

ElseIf InStr (1,strMatch, strY03, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY03

ElseIf InStr (1,strMatch, strY04, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY04

ElseIf InStr (1,strMatch, strY05, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY05

ElseIf InStr (1,strMatch, strY06, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY06

ElseIf InStr (1,strMatch, strY07, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY07

ElseIf InStr (1,strMatch, strY08, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY08

ElseIf InStr (1,strMatch, strY09, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY09

ElseIf InStr (1,strMatch, strY10, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY10

ElseIf InStr (1,strMatch, strY11, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY11

ElseIf InStr (1,strMatch, strY12, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY12

ElseIf InStr (1,strMatch, strY13, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY13

ElseIf InStr (1,strMatch, strY14, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY14

ElseIf InStr (1,strMatch, strY15, 1) > 0 Then
objExcel.Cells(intRow, 4).Value = strY15
End If

' ----------------------------------------------------------------
' Deel 6: kolom E, Hyperlink (Document naam weergeven en link naar document leggen)
' moet , zijn in plaats van ; anders geeft het een fout aan.

objExcel.Cells(intRow, 5).Value = "=HYPERLINK(""" & Subfolder.Path & "\" & objFile.Name& """,""" & objFile.Name & """)"
objExcel.Cells(intRow, 5).Font.Underline = False
objExcel.Cells(intRow, 5).Font.ColorIndex = 1


' ----------------------------------------------------------------
' Deel 7: vervolg deel 1
intRow = intRow + 1
Next

ShowSubFolders Subfolder
Next
End Sub