excel - Macros vba to list all inaccessible network folders -
i have vba code scans folder , subdirectories excel files , lists connection strings , sql command. problem program doesn't list inaccessible network folders gives error "access denied." wanna able list path folder , indicate on second column folder inaccessible. how should code it? i'm thinking
on error goto handler handler: if err.number = x orng.value = sfdr & sitem orng.offset(0, 1).value = "inaccessible folder" resume next end if
but code doesn't work. doesn't specify path of 'access denied' folder @ all. instead, puts text "inaccessible folder" next accessible excel file sees.
here's code:
private const file_filter = "*.xl*" private const srootfdr = "l:\application profile\greatplain-passsales" ' root folder private ofso object ' filesystemobject private orng range, n long ' range object , counter sub main() application.screenupdating = false set ofso = createobject("scripting.filesystemobject") n = 0 thisworkbook.worksheets("sheet1") .usedrange.clearcontents ' remove previous contents .range("a1:e1").value = array("filename", "connections", "connection string", "command text", "date scanned") set orng = .range("a2") ' initial cell start storing results end columns("a:e").select selection .wraptext = true .columnwidth = 45 .horizontalalignment = xlleft .verticalalignment = xlcenter end listfolder srootfdr application.screenupdating = true set orng = nothing set ofso = nothing columns.autofit msgbox n & " excel files has been checked connections." end sub private sub listfolder(byval sfdr string) dim ofdr object ' list files of directory listfiles sfdr, file_filter ' recurse each sub folder on error goto handler handler: if err.number = 5 orng.value = sfdr & sitem orng.offset(0, 1).value = "inaccessible folder" resume next end if each ofdr in ofso.getfolder(sfdr).subfolders listfolder ofdr.path & "\" ' need '\' ensure file filter works next end sub private sub listfiles(byval sfdr string, byval sfilter string) dim sitem string on error goto handler handler: if err.number = 52 orng.value = sfdr & sitem orng.offset(0, 1).value = "inaccessible folder" resume next end if sitem = dir(sfdr & sfilter) until sitem = "" n = n + 1 ' increment counter orng.value = sfdr & sitem checkfileconnections orng.value ' call sub check connection settings orng.offset(0, 4) = set orng = orng.offset(1) ' move range object next cell below sitem = dir loop end sub private sub checkfileconnections(byval sfile string) dim owb workbook, oconn workbookconnection dim sconn string, scmd string dim connectionnumber integer connectionnumber = 1 application.statusbar = "opening workbook: " & sfile on error resume next set owb = workbooks.open(filename:=sfile, readonly:=true, updatelinks:=false, password:=userpass) if err.number > 0 orng.offset(0, 1).value = "password protected file" else owb each oconn in .connections if len(sconn) > 0 sconn = sconn & vblf if len(scmd) > 0 scmd = scmd & vblf sconn = sconn & oconn.odbcconnection.connection scmd = scmd & oconn.odbcconnection.commandtext orng.offset(0, 1).value = connectionnumber ' 1 column right (b) orng.offset(0, 2).value = oconn.odbcconnection.connection ' 2 columns right (c) orng.offset(0, 3).value = oconn.odbcconnection.commandtext ' 3 columns right (d) connectionnumber = connectionnumber + 1 set orng = orng.offset(1) ' move range object next cell below next end end if owb.close false ' close without saving set owb = nothing application.statusbar = false end sub
hum, tried debugging code , found following.
your error handlers coded bit goofy. if handler gets triggered, yet error code not 1 testing for, re-invoke loop start. more clean code them as:
private sub listfolder(byval sfdr string) dim ofdr object, lfdr object ' list files of directory listfiles sfdr, file_filter ' recurse each sub folder on error goto handler each ofdr in ofso.getfolder(sfdr).subfolders listfolder ofdr.path & "\" ' need '\' ensure file filter works next exit sub handler: if err.number = 70 orng.value = sfdr orng.offset(0, 1).value = "inaccessible folder - access denied" end if resume next end sub
this ensures perform resume next errors trigger handler, not 1 error looking for. know listfiles() sub, re-entrance loop should work properly, still bad form. , code format not work listfolder() sub causes hard aborts.
when changed listfolder shown (and changed err.number checked 70), code seems work me. made both inaccessible files , folders, , proper error tag shown proper file names , directory names made inaccessible.
Comments
Post a Comment