none
Excel VBA Getting file attributes from network files copying files to my computer RRS feed

  • Question

  • Hello,

    Not sure if this is the right forum as it seems like it would be a generic VB/VBA problem, but since I'm trying this in VBA...

    All I'm trying to do is create a spreadsheet with file path, name etc.  Etc includes both standard and custom properties.  The code works fine when I run it pointing to folders on my C: drive.  However, when run it against a network share drive at work, it slows to a crawl.  Now, I expected it to be slow, but it's really bad. 

    Now for the weird part.  While I was running a test against a network share I noticed the harddrive light going crazy on my computer.  Via the Resource Monitor (Disk section) I found that Excel/VBA code is copying every single file to my harddrive!  So, for my test I was scanning ~6000 files.  It appears the code has to copy EVERY file to:  C:\Windows\ServiceProfiles\LocalService\AppData\Local\Temp\TfsStore\Tfs_DAV

    then read the file attributes from that file, then delete the file.  I watched the above folder as my code was running and it looked like it kept a running list of ~400 files there, deleting ones it read and loading in new ones as it went along.  When I run the code against a C: folder, it doesn't do this.

    Is the copying files to my computer and reading the attributes of them what it's supposed to do? I thought it would just read the attributes of the file at it's origional location. This copy thing it's doing is obviously a problem as most files are pretty large.

    Am I doing somthing wrong in the code? See below. Most it of was written by copying example files and me editting to fit my needs.

    Any ideas?  Thanks in advance!

    -Bob

     Sub ListMyFiles(folderPath, IncludeSubfolders)
        Dim i As Integer
        If folderPath = "" Then Exit Sub
        Set fsObject = New Scripting.FileSystemObject
        Set folderInfo = fsObject.GetFolder(folderPath)
       
     
        For Each FileInfo In folderInfo.Files
            iCol = 2
            If UserForm1.CheckBox1.Value Then Cells(iRow, iCol).Value = FileInfo.ParentFolder
            iCol = iCol + 1
            If UserForm1.CheckBox2.Value Then Cells(iRow, iCol).Value = FileInfo.Name
            iCol = iCol + 1
            If UserForm1.CheckBox3.Value Then Cells(iRow, iCol).Value = Right$(FileInfo.Name, Len(FileInfo.Name) - InStrRev(FileInfo.Name, "."))
            iCol = iCol + 1
            If UserForm1.CheckBox4.Value Then Cells(iRow, iCol).Value = FileInfo.Size
            iCol = iCol + 1
            If UserForm1.CheckBox5.Value Then Cells(iRow, iCol).Value = FileInfo.DateCreated
            iCol = iCol + 1
            If UserForm1.CheckBox6.Value Then Cells(iRow, iCol).Value = FileInfo.DateLastModified
            iCol = iCol + 1
       
        On Error GoTo myErrMsg1
            Set fileDSOinfo = New DSOFile.OleDocumentProperties
            dummy = fileDSOinfo.Open(FileInfo, True, dsoFileOpenOptions.dsoOptionOpenReadOnlyIfNoWriteAccess)
              
            If UserForm1.CheckBox7.Value Then Cells(iRow, 8).Value = fileDSOinfo.SummaryProperties.Author

            For i = 0 To fileDSOinfo.CustomProperties.count - 1
                Select Case fileDSOinfo.CustomProperties.Item(i).Name
                    Case "Content_Steward"
                        If UserForm1.CheckBox8.Value Then Cells(iRow, 9).Value = fileDSOinfo.CustomProperties.Item(i).Value
                    Case "Information_Classification"
                        If UserForm1.CheckBox9.Value Then Cells(iRow, 10).Value = fileDSOinfo.CustomProperties.Item(i).Value
                    Case "Record_Title_ID"
                        If UserForm1.CheckBox10.Value Then
                            Select Case fileDSOinfo.CustomProperties.Item(i).Value
                                Case 72
                                    Cells(iRow, 11).Value = "General Business Records"
                                Case 73
                                    Cells(iRow, 11).Value = "Guidelines, Policies, etc."
                                Case 2453
                                    Cells(iRow, 11).Value = "Process Technology Project Studies"
                                Case Else
                                    Cells(iRow, 11).Value = fileDSOinfo.CustomProperties.Item(i).Value
                            End Select
                        End If
                    Case "Initial_Creation_Date"
                        If UserForm1.CheckBox11.Value Then Cells(iRow, 12).Value = fileDSOinfo.CustomProperties.Item(i).Value
                    Case "Retention_Period_Start_Date"
                        If UserForm1.CheckBox12.Value Then Cells(iRow, 13).Value = fileDSOinfo.CustomProperties.Item(i).Value
                    Case "Last_Reviewed_Date"
                        If UserForm1.CheckBox13.Value Then Cells(iRow, 14).Value = fileDSOinfo.CustomProperties.Item(i).Value
                    Case "Retention_Review_Frequency"
                        If UserForm1.CheckBox14.Value Then Cells(iRow, 15).Value = fileDSOinfo.CustomProperties.Item(i).Value
                End Select
                iCol = iCol + 1
            Next
           
    myErrMsg1:
            If Err.Number <> 0 Then
                Cells(iRow, 1).Value = "Err"
               ' msg = "Error # " & str(Err.Number) & " was generated by " & Err.Source & Chr(13) & Err.Description
               ' MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
                Resume myResume1:
            End If
    myResume1:
            iRow = iRow + 1
            If (iRow - 7) Mod 10 = 0 Then Application.StatusBar = "Processing Files: " & iRow - 7

        Next
        On Error GoTo 0
       
        If IncludeSubfolders Then
            On Error GoTo myErrMsg2     ' skip locked folders
            For Each subFolder In folderInfo.SubFolders
                Call ListMyFiles(subFolder.path, True)
    myErrMsg2:
                Resume Next
            Next
        End If
       
    End Sub


    Robert J Staas, Sr.

    • Moved by Marvin_Guo Wednesday, April 16, 2014 7:41 AM VBA issue
    Monday, April 14, 2014 8:18 PM

Answers

  • Any idea on why the code is getting stuck in an infinate loop when accessing subfolders on the network? 

    The FileSearch code works, I've tested it on many system with different OS, also on servers / network drives.

    You think the code get stuck, because on a network drive with many sub folders it needs a very long time to get all the informations.

    It might also be possible that your network drive has limited access rights, means some of the folders / files are "read protected" and so it can take some time until the server throws an error.

    Place a breakpoint on the line

    'Create space for the output
    ReDim Data(1 To 14)

    then you can see when the FileSearch class has visited all subfolders. After the line

    For Each Item In .FoundFiles

    add the line
      DoEvents

    then you can press CTRL-BREAK to stop the code.

    Andreas.

    • Marked as answer by RsIsMe Sunday, April 20, 2014 11:37 PM
    Thursday, April 17, 2014 7:15 AM

All replies

  • Is the copying files to my computer and reading the attributes of them what it's supposed to do?

    IMHO no and I can't see a line in your code what is causing this.

    The Scripting.FileSystemObject is slow and inaccurate if you want to search for files. A network drive is a special case, I can not promise that my code is working faster on your network.

    Download this file and import it into your project, an example is included in the comments.
    https://dl.dropboxusercontent.com/u/35239054/FileSearch.cls

    Then try the code below.

    Andreas.

    Option Explicit
    
    Dim iRow As Long
    
    Sub Test()
      iRow = 2
      ListMyFiles "Z:\", True
    End Sub
    
    Private Sub ReDimA(ByRef Arr, LBoundA As Long, UBoundA As Long)
      'Does a "ReDim Arr(I)(LBoundA to UBoundA)" which is not possible directly!
      ReDim Arr(LBoundA To UBoundA, 1 To 1)
    End Sub
    
    Sub ListMyFiles(folderPath, ByVal IncludeSubfolders As Boolean)
      Dim fsObject, folderInfo, FileInfo, iCol
    
      Dim fs As New FileSearch
      Dim fso As Object 'Scripting.FileSystemObject
      Dim DSO As Object 'DSOFile.OleDocumentProperties
      Dim cp As Object 'DSOFile.CustomProperty
      Dim Data, Item
      Dim i As Long, j As Long
    
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set DSO = CreateObject("DSOFile.OleDocumentProperties")
    
      With fs
        'Initialize the search
        .Filename = "*.*"
        .LookIn = folderPath
        .SearchSubFolders = IncludeSubfolders
        'Go
        If .Execute = 0 Then Exit Sub
    
        'Create space for the output
        ReDim Data(1 To 14)
        For i = LBound(Data) To UBound(Data)
          ReDimA Data(i), 1, .FoundFiles.Count
        Next
        i = 0
        
        On Error GoTo ErrorHandler
        For Each Item In .FoundFiles
          'Next row
          i = i + 1
          'ParentFolder
          Data(1)(i, 1) = Left$(Item, InStrRev(Item, "\"))
          'Name
          Data(2)(i, 1) = Mid$(Item, InStrRev(Item, "\") + 1)
          'Extension
          Data(3)(i, 1) = Mid$(Item, InStrRev(Item, ".") + 1)
    
          'Get some properties with the Scripting.FileSystemObject
          With fso.GetFile(Item)
            Data(4)(i, 1) = .Size
            Data(5)(i, 1) = .DateCreated
            Data(6)(i, 1) = .DateLastModified
          End With
          
          'Get some properties with DSOFile.OleDocumentProperties
          With DSO
            .Open Item, True, 2
            Data(7)(i, 1) = .SummaryProperties.Author
    
            For Each cp In .CustomProperties
              With cp
                Select Case .Name
                  Case "Content_Steward"
                    Data(8)(i, 1) = .Value
                  Case "Information_Classification"
                    Data(9)(i, 1) = .Value
                  Case "Record_Title_ID"
                    Select Case .Value
                      Case 72: Data(10)(i, 1) = "General Business Records"
                      Case 73: Data(10)(i, 1) = "Guidelines, Policies, etc."
                      Case 2453: Data(10)(i, 1) = "Process Technology Project Studies"
                      Case Else: Data(10)(i, 1) = .Value
                    End Select
                  Case "Initial_Creation_Date"
                    Data(11)(i, 1) = .Value
                  Case "Retention_Period_Start_Date"
                    Data(12)(i, 1) = .Value
                  Case "Last_Reviewed_Date"
                    Data(13)(i, 1) = .Value
                  Case "Retention_Review_Frequency"
                    Data(14)(i, 1) = .Value
                End Select
              End With
            Next
            .Close
          End With
    Skip:
        Next
    
        'Write the result into the sheet
        j = 0
        For i = LBound(Data) To UBound(Data)
          If UserForm1.Controls("CheckBox" & i) Then
            Cells(iRow, 2).Offset(, j).Resize(UBound(Data(i))) = Data(i)
            j = j + 1
          End If
        Next
      End With
     
      Exit Sub
    ErrorHandler:
      Resume Skip
    End Sub
    


    Tuesday, April 15, 2014 3:24 PM
  • Andreas,

    Thank you so much for your help!  It seems hard enough to get people to reply at all, but for someone (i.e., YOU) to go so far out of the way to customize the "example" to match my original mess is absolutely fantastic and way above what I would ever have expected.  And, to make it even more amazing, it actually works!  Do you how many times I find example code that I can never quite get to run.

    Unfortunately, I tried this at work--where I really need it-- and had trouble running it as I missed the extremely important part about saving/importing the .cs file.  I'm currently working with it on it on my home computer which has no network drives that I really want to run this against.  But, I reread your instructions and got it working perfectly.

    I'll send my updated file using your code to my work computer and try it there tomorrow.  I'm very excited about trying it there against a network drive.  As a quick speed test, I ran my old version and your version against the "my documents" folder on my home computer.  WOW!  What a difference!  For a total of 24804 files, my version took 4:28 (m:ss).  Your version took a whole 39 seconds to scan the same files!

    I'll need to figure out how to send out a "Hey, Andreas.  I got another question for you." in these forums.  :)

    I'll reply here again tomorrow to let you know how it works on a network drive.

    Again, thanks so much! 

    -Bob


    Robert J Staas, Sr.

    Wednesday, April 16, 2014 12:51 AM
  • Hi Robert J Staas,

    The VBA Forum will be a better forums for you to ask this question. And I will help you to move your case to VBA Forum.
    Thank you very much for your understanding.

    Best Regards,
    Marvin


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Wednesday, April 16, 2014 7:40 AM
  • Andreas,

    I wanted to get back to you on how I made out trying this against a network drive.  Not good!

    Long story... It works fine if I don't select IncludeSubfolders.  If I do select IncludeSubfolders then in gets stuck in an infinite loop in the .cs class code where I can't "Esc" or "Control Break" from it and it runs until I get an "Out of memory" error pop up.  I can only stop it via task manager.

    Trying to step through the code, it runs in the VBA section up to the "With fs" statement then jumps into the class code where I get lost trying to understand what it's doing.

    Now, using it with the IncludeSubfolders selected runs fine on my home and work computer accessing folders on the C: drive, it just gets stuck with that option on folders on network drive.   I tried starting at different folders to rule out a problem folder/subfolder, but that didn't help.  Weird.  I'm just doing a test starting with a folder that only has 1 or 2 subfolders, so it's not like it's getting overloaded with stuff.

    For the speed side, it was hard to get a good test as I couldn't include subfolders.  But, comparing scans of 70 files in one folder on the network using the two versions of code did look better.  For 70 files, it took my code 12 seconds and your code 5 seconds to scan them.  Certainly not as good an improvement as what I was seeing last night running it against C: drive folders, but certainly going in the right direction.  I certainly expect doing this over the network to be slower.

    Any idea on why the code is getting stuck in an infinate loop when accessing subfolders on the network?  Do you have access to a network drive/folders where you can test it?

    Thanks so much for your help!

    -Bob



    Robert J Staas, Sr.

    Wednesday, April 16, 2014 5:33 PM
  • Any idea on why the code is getting stuck in an infinate loop when accessing subfolders on the network? 

    The FileSearch code works, I've tested it on many system with different OS, also on servers / network drives.

    You think the code get stuck, because on a network drive with many sub folders it needs a very long time to get all the informations.

    It might also be possible that your network drive has limited access rights, means some of the folders / files are "read protected" and so it can take some time until the server throws an error.

    Place a breakpoint on the line

    'Create space for the output
    ReDim Data(1 To 14)

    then you can see when the FileSearch class has visited all subfolders. After the line

    For Each Item In .FoundFiles

    add the line
      DoEvents

    then you can press CTRL-BREAK to stop the code.

    Andreas.

    • Marked as answer by RsIsMe Sunday, April 20, 2014 11:37 PM
    Thursday, April 17, 2014 7:15 AM
  • Andreas,

    Thanks for your reply.  I spent a lot time on this today and wanted to give another update on what I found out so far.

    The problem I'm having seems to be server/folder dependent.  I picked different servers/paths and it DID work fine as you say.  GREAT!

    In case you, or anyone else, is interested, there seems to be a special case maybe that's not getting handled properly and thus runs in a loop until Excel/my computer runs out of memory.  Getting that from Excel displaying an "Out of Memory" error after it runs for a long, long time.

    First, adding the DoEvents helped greatly for stopping it when I need to.  I added it just under the "Do" where it loops forever in the class code:

        If hFindFile <> INVALID_HANDLE_VALUE Then
          Do
            DoEvents
            With hFoundFile

    Also, in an attempt to see what's going on I added right below the RaiseEvent BeforeSearchFolder(Path & FName, Cancel) a MsgBox:

      MsgBox Path & " " & FName

    I just keep hitting the Ok button on the MsgBox to continue with the next cycle of the loop.  What the MsgBox is showing me is that in the case that it never exists the loop, the Path just keeps growing on forever as follows:
    (Well, this is hard to show here as I don't want to put here what my real path is, but I can say that this whole thing works fine IF SearchSubFolders is NOT selected.  So, from what I'm showing as path is a valid path.  Hopefully, that's clear.)  Also, I'm just showing "test" here as an example folder.  Picking other folders on that server produce the same results.

    I pass "\\#####\test" as my starting folder.

    From the MsgBox display, "Path" grows like this on each loop...

    Starts out: \\#####\test\..\
    Then: \\#####\test\..\.\
    Then: \\#####\test\..\.\.\
    Then: \\#####\test\..\.\.\.\
    Then: \\#####\test\..\.\.\.\.\
    Then: \\#####\test\..\.\.\.\.\.\

    Believe me, it keeps on going like that.

    So, it appears the Do loop never exits and the variable "Path" just keeps getting appended with ".\" until it runs out of memory.


    Related to the speed improvement from your code...
    First, I'm working from home today so calling anything speedy really is a joke as our company's network is really poor to begin with.  Add to that accessing the network via VPN over my non-speedy High-speed FIOS setup is a joke.  But, that said, I can still get a speed measurement by running your code version against my code version and get a valid comparison.

    Also, just to state the obvious, it may appear from my examples with a few files that this may seem like a lot of work for the few files I'm talking about.  These are just test folders/files as a way of getting it to work at all and do some basic speed testing.  Once it's "ready for prime time," I'll be running it to scan at a minimum of 60,000+ files, maybe more if others find having this info as useful as I do.

    So, for the speed testing...  On a network server that I could get the code to work on, I picked a folder with  11 files which also contained one subfolder with 3 files in it, for a total of 14 files.  My code took a "speedy" 5 min 18 sec.  Your code took 1 min 13 sec.

    So, like I said in a previous note, your code is the way go!

    Any thoughts on what might be going on with the "Path" variable / loop problem.  I'm still be interested in finding out more on that as, like I said, it's success/failure seems it may be server/folder dependent.  It would be good to know as I can't say ahead of time what server(s) I'll be running this against to tell if it will run on them OK or not.

    Again, thanks so much for your help with this!

    -Bob


    Robert J Staas, Sr.

    Thursday, April 17, 2014 8:17 PM
  • Andreas,

    I'm going to go ahead and mark this as "answered" as I found the problem.  Again, thanks so much for your help!

    If anybody is interested in the cause and fix, here it is...

    I really don't know what this means, but the folders on the server I was having trouble with have an extra tab in their Properties window named DFS that contains and entry for a different server than what I'm accessing.  If anybody can tell me what that's for, I'd appreciate it.

    In the Class code I downloaded from above, there is an line of code that comes commented out.  One of the first things I did was uncomment it, but that didn't work.  It turns out that code does need to be uncommented, but as supplied, is not in the correct location either.  I moved it to where shown below, and now everything is working great no matter what server.

    So, if anyone cares heres the code:

    WAS:

                AddIt = InStr(.cAlternate, vbNullChar) > 1
                If Not AddIt Then
                 ' AddIt = Left$(.cFileName, 1) <> "."
                  For j = 1 To Len(.cFileName)

    The Fix:

                AddIt = InStr(.cAlternate, vbNullChar) > 1 and Left$(.cFileName, 1) <> "."
                If Not AddIt Then
                  For j = 1 To Len(.cFileName)

    Thanks!


    Robert J Staas, Sr.

    Sunday, April 20, 2014 11:37 PM
  • WAS:

                AddIt = InStr(.cAlternate, vbNullChar) > 1
                If Not AddIt Then
                 ' AddIt = Left$(.cFileName, 1) <> "."
                  For j = 1 To Len(.cFileName)

    The Fix:

                AddIt = InStr(.cAlternate, vbNullChar) > 1 and Left$(.cFileName, 1) <> "."
                If Not AddIt Then
                  For j = 1 To Len(.cFileName)


    Robert,

    Thanks for the detailed report which can be helpful indeed.

    When you change my code as shown above, then you will not find subdirectories whose names begin with a dot. And it is possible and usual that such directories exists!

    E.g. when you install Oracle VM VirtualBox, you find the subdirectory
    ".VirtualBox" within "C:\Documents and Settings\"

    BTW, it is also possible that files exists whose name begin with a dot!

    Sub Test()
      MkDir "c:\.test"
      Open "c:\.test\.file.txt" For Random As 1
      Close #1
    End Sub

    A bit more background informations: In the development stage when I added this part, I tested it only on WinXP machines. Later when I tried it on Win7 machines I found two problems which I had not expected:

    a) 64-bit file systems have a redirector, which bend the file paths to 64-bit files to there 32-bit equivalents when the calling thread is 32-bit.

    b) It is possible to use UniCode chars within directory/file names, what leads to strange abbreviations in the 8.3 structure of a file name. ".cAlternate"is the short name, ".cFileName" is the long name.

    The most problems where gone after I disabled the 64-bit redirector and since I use the UniCode call of the FindFile function, I've not heard of any problems longer.

    Anyway, you said that the windows explorer shows an extra tab DFS, IMHO that is a "Distributed File System" on an old Win2K server:

    http://technet.microsoft.com/en-us/library/cc962128.aspx

    If I am right in my assumption... wow! It is amazing that the code works! Official it is not supported! Whatever your Admin has screwed together on that server, don't touch it, don't ask for, that's magic.

    But you can try one thing, in my class module at the top, you'll see this define:
    #Const UniCode = True

    Change it to False, it might be possible that the behavior changes.

    Andreas.


    Monday, April 21, 2014 7:57 AM
  • Thanks Andreas for replying back.

    I didn't think about filenames and folders beginning with a ".".  I've never seen it here, but it's not really something I have ever paid attention to.  And to be honest, I really don't go poking around on the servers, so who knows what really exists there in our environment.

    I had tried changing the UniCode = False trick before I started messing with the code, but it didn't help at all.  If I'm reading your note correctly, it sounds like your code was really designed for the server I have trouble with, i.e., the one with the folders having a DFS tab.  That's Ok really, it was pretty much a place to test stuff.  The other two servers that it worked on Ok are the ones with the real data I'm interested in.  Not knowing what was going on with the code, I was trying to get it to work everywhere.

    Given some speed testing i did on this today from work, it looks like it will take between 12 and 13 hours to do my real scan against the production server for my 61000+ files.  I'm going to change the code back to what you had originally for this to capture any "." starting folders/files, though I had never seen any in my testing.  I'm going to start it before I leave work and let it run overnight.  Hopefully, it can handle that many files.  We'll see.

    Again, thanks for your help!

    -Bob


    Robert J Staas, Sr.

    Monday, April 21, 2014 8:01 PM