Go Premium for a chance to win a PS4. Enter to Win


How to mofify this VBA sprea sheet for my needs

Posted on 2011-09-09
Medium Priority
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
'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
'this is in case a Permission denied error comes up or an unforeseen error
'Do nothing, just go to next file
     Next x

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

ToggleStuff True
End Function

Open in new window

Question by:nassio1985
LVL 42

Expert Comment

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!


Accepted Solution

slycoder earned 2000 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:

Author Closing Comment

ID: 36513193
Thanks sorry if I posted again

Featured Post

[Webinar] Cloud Security

In this webinar you will learn:

-Why existing firewall and DMZ architectures are not suited for securing cloud applications
-How to make your enterprise “Cloud Ready”, and fix your aging DMZ architecture
-How to transform your enterprise and become a Cloud Enabler

Question has a verified solution.

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

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
If you are a mobile app developer and especially develop hybrid mobile apps then these 4 mistakes you must avoid for hybrid app development to be the more genuine app developer.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Introduction to Processes

971 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