Kompileringsfejl i deletefolder via excell

Hej

Jeg forsøger at lave et opslag via excell som så sletter profil for de brugere der er i arket.

Men jeg får en fejl i linje 61 tegn 1 kode 800A03EA

Hvis jeg køre script uden excell opslag,(linje 41 til 86(fjern ' fra dim arrFolders()) virker det fint, jeg skal her skrive sti til den mappe der skal slettes, i linje 47 strFolderName = "q:\blabla\profil"

Jeg vil gerne have at den laver opslaget og sætter sti og brugernavn ind fra excell, og looper indtil der ikke er flere navne i excell.



Script
' UserSpreadsheet .vbs
'
' -------------------------------------------------------------------------'
Option Explicit
Dim objUser, objFSO, objDomain
Dim objExcel, objSpread, intRow, InputPrompt1
Dim strUser, strOU1, strCNOU, strdc1, strdc2, strSheet
Dim strBrugernavn, strCN, strOU2, strDomainName
Dim strProfileFolder, strhomeDirectory, strFolderName
Dim strComputer, intSize, arrFolders(), objFolder, strFolder
Dim colSubfolders, colSubfolders2, objWMIService



' -------------------------------------------------------------------------'
' Important change OU= and strSheet to reflect your domain
' -------------------------------------------------------------------------'

strDomainName = "XXXXXX.DK"
strOU2 = "02_XXXX"
strhomeDirectory = "Y:\"


InputPrompt1 = "Domain = "&strDomainName&vbCrLf&"Container = "&strOU2&vbCrLf&vbCrLf&"Sti og navn Til Excell XLS, eks Q:\brugeradm\Excell.xls"

strSheet  = InputBox(InputPrompt1)

' Open the Excel spreadsheet
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)


' On Error Resume next
intRow = 4 'Row 1 often contains headings


Do Until objExcel.Cells(intRow,1).Value = ""
  strBrugernavn = Trim(objExcel.Cells(intRow, 1).Value)

'Dim arrFolders()
intSize = 0

'strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

strFolderName = strhomeDirectory & strBrugernavn

Set colSubfolders = objWMIService.ExecQuery _
    ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
        & "Where AssocClass = Win32_Subdirectory " _
            & "ResultRole = PartComponent")

ReDim Preserve arrFolders(intSize)
arrFolders(intSize) = strFolderName
intSize = intSize + 1

For Each objFolder in colSubfolders
    GetSubFolders strFolderName
Next

Sub GetSubFolders(strFolderName)
    Set colSubfolders2 = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
            & "Where AssocClass = Win32_Subdirectory " _
                & "ResultRole = PartComponent")

    For Each objFolder2 in colSubfolders2
        strFolderName = objFolder2.Name
        ReDim Preserve arrFolders(intSize)
        arrFolders(intSize) = strFolderName
        intSize = intSize + 1
        GetSubFolders strFolderName
    Next
End Sub

For i = Ubound(arrFolders) to 0 Step -1
    strFolder = arrFolders(i)
    strFolder = Replace(strFolder, "\", "\\")
    Set colFolders = objWMIService.ExecQuery _
        ("Select * from Win32_Directory where Name = '" & strFolder & "'")

    For Each objFolder in colFolders
        errResults = objFolder.Delete
    Next
Next


intRow = intRow + 1
Loop
objExcel.Quit

Ps

Til at starte med skal den slette profilerne, men skulle gerne ende med at slette både p-drev og profilmapper

Tak Herfra