Solved

Error in loop

Posted on 2011-09-15
6
278 Views
Last Modified: 2012-05-12
Hello everyone,
I have a function that returns the file properties(such as filesize, creation date, modification date) of a file in column A of a excel spread sheet, what I need is to make this function loop trough all the path in column A; I tried to create a loop with some help but right now the loop is working but is not giving me back the values, the function seems to straight away jump in the CASE else part, does anyone knows how to make work properly? spread sheet screen shot
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(myFile))
        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 = "txt"
    End Select
End Function

Public Sub SperiamoLoop()
    Dim MyCell As Variant, Rng As Range
    Dim myFile As String, myType As String
    Set Rng = Sheets("Sheet1").Range("A2:A4")
    For Each MyCell In Rng
        If MyCell <> "" Then
            myFile = Left(MyCell, InStr(MyCell, "\") - 1)
            myType = Mid(MyCell, InStr(MyCell, "\") + 1)
            MyCell.Offset(0, 1) = GetFileProperty(myFile, myType)
        End If
    Next
End Sub

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
  • 2
6 Comments
 
LVL 37

Expert Comment

by:TommySzalapski
ID: 36544667
  myFile = Left(MyCell, InStr(MyCell, "\") - 1)
This will pull the C: off each one and nothing else
  myType = Mid(MyCell, InStr(MyCell, "\") + 1)
This will pull everything after the first \

Shouldn't the select case be using the type not the filename?
0
 
LVL 37

Assisted Solution

by:TommySzalapski
TommySzalapski earned 500 total points
ID: 36544732
Try this code and make sure the things in row 1 are EXACTLY the same as the cases (so row 1 starting at column B should be CREATED MODIFIED ACCESSED SIZE)

Here's my code which works if all the files exist.
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 = "txt"
    End Select
End Function

Public Sub SperiamoLoop()
    Dim MyCell As Variant, Rng As Range
    Dim myFile As String, myType As String
    Set Rng = Sheets("Sheet1").Range("A2:A4")
    For Each MyCell In Rng
        myFile = MyCell.Value
        If myFile <> "" Then
            For i = 1 To 4
                myType = Sheets("Sheet1").Range("A1").Offset(0, i)
                MyCell.Offset(0, i) = GetFileProperty(myFile, myType)
            Next
        End If
    Next
End Sub

Open in new window

0
 
LVL 37

Accepted Solution

by:
TommySzalapski earned 500 total points
ID: 36544755
Actually, repace the first function with this so it won't crash if the file does not exist. But remember that the names in row 1 must match the ones used in the code exactly.

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")

    If oFS.FileExists(myFile) Then
        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 = "txt"
        End Select
    Else
        GetFileProperty = "File does not exist"
    End If
End Function

Open in new window

0
The Ultimate Checklist to Optimize Your Website

Websites are getting bigger and complicated by the day. Video, images, custom fonts are all great for showcasing your product/service. But the price to pay in terms of reduced page load times and ultimately, decreased sales, can lead to some difficult decisions about what to cut.

 
LVL 4

Expert Comment

by:AnthonyHamon
ID: 36544811
The code you attach has several bugs.  The code attached is much closer.
Sub SperiamoLoop()
Dim MyCell As Variant
Dim MyRng As Range
Dim MyFile As String
Dim MyType As String
Dim i As Integer
Dim oFS As Object
Set MyRng = Range("A2:A4")
For Each MyCell In MyRng
    i = Len(MyCell)
    Do While i > 0
        If Mid(MyCell, i, 1) = "." Then
            MyCell.Offset(0, 1).Value = Mid(MyCell, i + 1, 255)
            Exit Do
        End If
        i = i - 1
    Loop
     'This creates an instance of the MS Scripting Runtime FileSystemObject class
    Set oFS = CreateObject("Scripting.FileSystemObject")
    MyCell.Offset(0, 2) = oFS.GetFile(MyCell).DateCreated
    MyCell.Offset(0, 3) = oFS.GetFile(MyFile).DateLastModified
Next
End Sub

Open in new window

0
 

Author Comment

by:nassio1985
ID: 36545270
AnthonyHamon:I used your code but it does wipe out some cell, please have a look on the screen shot have a look
0
 

Author Comment

by:nassio1985
ID: 36545286
sorry the above comment was for TommySzalapsk
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Computer science students often experience many of the same frustrations when going through their engineering courses. This article presents seven tips I found useful when completing a bachelors and masters degree in computing which I believe may he…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

690 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