Solved

How to mofify this VBA sprea sheet for my needs

Posted on 2011-09-09
3
297 Views
Last Modified: 2012-08-14
Hello guys,
What I'd like to do is modify this macro because what I like to obtain is: for example I have one path like \\servername\folder\subfolder\subfolder\file into a column,row(A1) and I'd like to set it up as variable instead of choosing the path manually by browsing the folders. How can I modify the code in the attachment below? Any help will be appreciate, but if you could tell me exactly what to do it's better!!! :) thanks in advance
Option Explicit
Sub PopulateDirectoryList()
'dimension variables
Dim objFSO As FileSystemObject, objFolder As Folder
Dim objFile As File, strSourceFolder As String, x As Long, i As Long
Dim wbNew As Workbook, wsNew As Worksheet

ToggleStuff False 'turn of screenupdating

Set objFSO = New FileSystemObject  'set a new object in memory
strSourceFolder = BrowseForFolder 'call up the browse for folder routine
If strSourceFolder = "" Then Exit Sub

Workbooks.Add 'create a new workbook

Set wbNew = ActiveWorkbook
Set wsNew = wbNew.Sheets(1) 'set the worksheet
wsNew.Activate
'format a header
With wsNew.Range("A1:F1")
    .Value = Array("File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size")
    .Interior.ColorIndex = 7
    .Font.Bold = True
    .Font.Size = 12
End With

With Application.FileSearch
    .LookIn = strSourceFolder  'look in the folder browsed to
    .FileType = msoFileTypeAllFiles 'get all files
    .SearchSubFolders = True  'search sub directories
    .Execute  'run the search
           
    For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index)
       i = x 'make the variable i = x
       If x > 60000 Then  'if there happens to be more than multipls of 60,000 files, then add a new sheet
          i = x - 60000  'set i to the right number for row placement below
          Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))
          With wsNew.Range("A1:F1")
            .Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _
                                               "Last Accessed", "Size")
            .Interior.ColorIndex = 7
            .Font.Bold = True
            .Font.Size = 12
           End With

       End If
        On Error GoTo Skip 'in the event of a permissions error
          
        Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties
         With wsNew.Cells(1, 1) 'populate the next row with the variable data
             .Offset(i, 0) = objFile.Name
             .Offset(i, 1) = Format(objFile.Size, "0,000") & " KB"
             .Offset(i, 2) = objFile.DateLastModified
             .Offset(i, 3) = objFile.DateLastAccessed
             .Offset(i, 4) = objFile.DateCreated
             .Offset(i, 5) = objFile.Path
             
         End With
          ' Next objFile
Skip:
'this is in case a Permission denied error comes up or an unforeseen error
'Do nothing, just go to next file
     Next x
wsNew.Columns("A:F").AutoFit

End With

'clear the variables
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
Set wsNew = Nothing
Set wbNew = Nothing
       
ToggleStuff True 'turn events back on
End Sub
Sub ToggleStuff(ByVal x As Boolean)
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub


Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    '''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission
     
  Dim ShellApp As Object
  Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
    Set ShellApp = Nothing
     
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
        End Select
    Exit Function

Invalid:
   
    
ToggleStuff True
End Function

Open in new window

0
Comment
Question by:nassio1985
3 Comments
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
>>have one path like \\servername\folder\subfolder\subfolder\file into a column,row(A1) and I'd like to set it up as variable instead of choosing the path manually by browsing the folders.

I believe all you need to do is change line 11, for quick validation.  Instead of calling the BrowseForFolder function, just pull the folder from A1 (assumes the folder is in the workbook where you're writing your macros?

dim wkb as workbook
dim sht as worksheet

  set wkb = ThisWorkbook 'change as necessar
  set sht = ThisWorkbook.ActiveSheet 'or Thisworkbook.Sheets("whatever")

   strSourceFolder = sht.Range("A1").value


Let me know if this help!

Dave
0
 
LVL 5

Accepted Solution

by:
slycoder earned 500 total points
Comment Utility
I answered a similar question earlier -

I would create a macro/function:

1) access the Macro IDE with Alt+F11
2) insert a new module - Insert - Module
3) insert a new function - Insert - Procedure - type "GetFileProperty"and click type "Function" click on OK

Then replace the function with this:


Public Function GetFileProperty(myFile As String, myType As String) As String

    'This creates an instance of the MS Scripting Runtime FileSystemObject class
    Set oFS = CreateObject("Scripting.FileSystemObject")

    Select Case UCase(Trim(myType))
        Case "CREATED"
            GetFileProperty = oFS.GetFile(myFile).DateCreated
        Case "MODIFIED"
            GetFileProperty = oFS.GetFile(myFile).DateLastModified
        Case "ACCESSED"
            GetFileProperty = oFS.GetFile(myFile).DateLastAccessed
        Case "SIZE"
            GetFileProperty = oFS.GetFile(myFile).Size
        Case Else
            GetFileProperty = "#Need Type#"
    End Select
End Function



To use the function - in Column  A = you would have your list of files, then

just use the function in the appropriate columns:
=GetFileProperty(A1,"created")
=GetFileProperty(A1,"modified")
=GetFileProperty(A1,"accessed")
=GetFileProperty(A1,"size")
0
 

Author Closing Comment

by:nassio1985
Comment Utility
Thanks sorry if I posted again
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
If you’re thinking to yourself “That description sounds a lot like two people doing the work that one could accomplish,” you’re not alone.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now