?
Solved

VBscript in excel 2003 does not work in office 2010 - help with conversion

Posted on 2011-10-30
9
Medium Priority
?
470 Views
Last Modified: 2012-05-12
I have vb script in an excel spreadsheet attached (thanks to EE) which populates a spreadsheet with a list of file names and specified properties from a selected directory- works perfectly.  Just upgraded to office 2010 and although this script runs, does not return the file properties. Can someone either amend the script or post a file with amended script populatefromfolders.xls
Public X()
Public i As Long
Public objShell, objFolder, objFolderItem
Public FSO, oFolder, Fil
 
Sub MainExtractData()
     
    Dim NewSht As Worksheet
    Dim MainFolderName As String
    Dim TimeLimit As Long, StartTime As Double
     
    Dim X(1 To 65536, 1 To 11)
     
    Set objShell = CreateObject("Shell.Application")
    TimeLimit = Application.InputBox("Please enter the maximum time that you wish this code to run for in minutes" & vbNewLine & vbNewLine & _
    "Leave this at zero for unlimited runtime", "Time Check box", 0)
    StartTime = Timer
     
    Application.ScreenUpdating = False
    MainFolderName = BrowseForFolder()
    Set NewSht = ThisWorkbook.Sheets.Add
    
     
    X(1, 1) = "Path"
    X(1, 2) = "File Name"
    X(1, 3) = "Last Accessed"
    X(1, 4) = "Last Modified"
    X(1, 5) = "Created"
    X(1, 6) = "Type"
    X(1, 7) = "Size"
    X(1, 8) = "Subject"
    X(1, 9) = "Author"
    X(1, 10) = "Owner"
    X(1, 11) = "title"
     
    i = 1
     
    Set FSO = CreateObject("scripting.FileSystemObject")
    Set oFolder = FSO.GetFolder(MainFolderName)
     'error handling to stop the obscure error that occurs at time when retrieving DateLastAccessed
    On Error Resume Next
    For Each Fil In oFolder.Files
        Set objFolder = objShell.Namespace(oFolder.Path)
        Set objFolderItem = objFolder.ParseName(Fil.Name)
        i = i + 1
        If i Mod 20 = 0 And TimeLimit <> 0 And Timer > (TimeLimit * 60 + StartTime) Then
            GoTo FastExit
        End If
        If i Mod 50 = 0 Then
            Application.StatusBar = "Processing File " & i
            DoEvents
        End If
        X(i, 1) = oFolder.Path
        X(i, 2) = Fil.Name
        X(i, 3) = Fil.DateLastAccessed
        X(i, 4) = Fil.DateLastModified
        X(i, 5) = Fil.DateCreated
        X(i, 6) = Fil.Type
        X(i, 7) = Fil.Size
        X(i, 8) = objFolder.GetDetailsOf(objFolderItem, 11)
        X(i, 9) = objFolder.GetDetailsOf(objFolderItem, 9)
        X(i, 10) = objFolder.GetDetailsOf(objFolderItem, 8)
        X(i, 11) = objFolder.GetDetailsOf(objFolderItem, 10)
    Next
     
     'Get subdirectories if needed
    If TimeLimit = 0 Then
        Call RecursiveFolder(oFolder, 0)
    Else
        If Timer < (TimeLimit * 60 + StartTime) Then Call RecursiveFolder(oFolder, TimeLimit * 60 + StartTime)
    End If
     
FastExit:
    Range("A:K") = X
    If i < 65535 Then Range(Cells(i + 1, "A"), Cells(65536, "A")).EntireRow.Delete
    Range("A:K").WrapText = False
    Range("A:K").EntireColumn.AutoFit
    Range("1:1").Font.Bold = True
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Range("a1").Activate
     
    Set FSO = Nothing
    Set objShell = Nothing
    Set oFolder = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
    Set Fil = Nothing
    Application.StatusBar = ""
    Application.ScreenUpdating = True
End Sub
 
Sub RecursiveFolder(xFolder, TimeTest As Long)
    Dim SubFld
    For Each SubFld In xFolder.SubFolders
        Set oFolder = FSO.GetFolder(SubFld)
        Set objFolder = objShell.Namespace(SubFld.Path)
        For Each Fil In SubFld.Files
            Set objFolder = objShell.Namespace(oFolder.Path)
             'Problem with objFolder at times
            If Not objFolder Is Nothing Then
                Set objFolderItem = objFolder.ParseName(Fil.Name)
                i = i + 1
                If i Mod 20 = 0 And TimeTest <> 0 And Timer > TimeTest Then
                    Exit Sub
                End If
                If i Mod 50 = 0 Then
                    Application.StatusBar = "Processing File " & i
                    DoEvents
                End If
                X(i, 1) = SubFld.Path
                X(i, 2) = Fil.Name
                X(i, 3) = Fil.DateLastAccessed
                X(i, 4) = Fil.DateLastModified
                X(i, 5) = Fil.DateCreated
                X(i, 6) = Fil.Type
                X(i, 7) = Fil.Size
                X(i, 8) = objFolder.GetDetailsOf(objFolderItem, 11)
                X(i, 9) = objFolder.GetDetailsOf(objFolderItem, 9)
                X(i, 10) = objFolder.GetDetailsOf(objFolderItem, 8)
                X(i, 11) = objFolder.GetDetailsOf(objFolderItem, 30)
            Else
                Debug.Print Fil.Path & " " & Fil.Name
            End If
        Next
        Call RecursiveFolder(SubFld, TimeTest)
    Next
End Sub
 
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    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:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

Open in new window

0
Comment
Question by:grayderek
  • 5
  • 4
9 Comments
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 37053720
Seems to be working for me in Excel 2010, although I am noticing that it is not recursing through the "child" directories.

You may want to have a look at this:

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_25063189.html#a26340696

It provides the option to drill through the child directories, if desired.
0
 
LVL 2

Author Comment

by:grayderek
ID: 37054227
matthewspatrick:  The code sugestted works as does mine however I need to return the title, subject, author etc can you provide the additional code please.
0
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 37054736
Just graft in the code from your that already grabs those attributes.
0
Fill in the form and get your FREE NFR key NOW!

Veeam is happy to provide a FREE NFR server license to certified engineers, trainers, and bloggers.  It allows for the non‑production use of Veeam Agent for Microsoft Windows. This license is valid for five workstations and two servers.

 
LVL 2

Author Comment

by:grayderek
ID: 37055402
matthewspatrick:  This is where my problem is, the original code does not return the correct property information for 'title', 'subject' 'author' etc.  
The code you directed me too does not have these properties - I have tried grafting my code but my skills not good I just get object not specified etc. (this is why I come here :),

With my posted code I get all items from line 53 to 59; the info returned for lines 60-63 is incorrect.  Could someone either provide amendments to my code or additions to the one linked please.
0
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 37056330
Your code is returning those attributes for me where the files actually have the attributes populated.  However, not every file will actually have the attributes populated.  If the file attributes aren't populated, then no code is going to be able to pull them.
0
 
LVL 2

Author Comment

by:grayderek
ID: 37058059
matthewspatrick: My code works in Windows xp with office 2003 environment, but as said it does not work for the properties stated since upgrading to windows 7 and office 2010.
(I am aware that no data can returned when no properties populated :)
Are you testing my code on a windows 7 with office 2010?
If this helps; Having checked the vb references on both pc's they are the same except  2003 has MS object libraries 11 listed and 2010 pc has 2003 has MS object libraries 14
0
 
LVL 93

Assisted Solution

by:Patrick Matthews
Patrick Matthews earned 600 total points
ID: 37058379
Ah.  I'm using Office 2010 and Windows XP.  Could be a Windows 7-specific issue.

I suggest you click 'Request Attention', and ask the Mods to add the Windows 7 zone and send Designated Expert alerts.
0
 
LVL 2

Accepted Solution

by:
grayderek earned 0 total points
ID: 37061147
Cracked it! thanks in part to matthewspatrick, between us we narrowed down the problem to windows 7.  I browsed window 7 zone and found the answer embedded in another question.

Different versions of WIndows have different numbers for the attributes (properties).  The link below lists them for XP, vista and windows 7
http://www.kixtart.org/forums/ubbthreads.php?ubb=showflat&Number=160880&page=1

I changed the numbers to windows 7 ones and presto, thanks MSoft not.


0
 
LVL 2

Author Closing Comment

by:grayderek
ID: 37087362
The dialogue between two members help to solve the problem.  The change in attribute numbers between MS operating systems should be broadcast more widely.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
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.

840 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