Solved

How to mofify this VBA sprea sheet for my needs

Posted on 2011-09-09
3
305 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 42

Expert Comment

by:dlmille
ID: 36512787
>>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
ID: 36512795
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
ID: 36513193
Thanks sorry if I posted again
0

Featured Post

MS Dynamics Made Instantly Simpler

Make Your Microsoft Dynamics Investment Count  & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
Six Sigma Control Plans
Starting up a Project

636 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