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

Popular posts from this blog

javascript - AngularJS custom datepicker directive -

javascript - jQuery date picker - Disable dates after the selection from the first date picker -