asked on

Error in loop

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?

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

TommySzalapski

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?

SOLUTION

TommySzalapski

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER CERTIFIED SOLUTION

TommySzalapski

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

AnthonyHamon

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

nassio1985

ASKER

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

nassio1985

ASKER

sorry the above comment was for TommySzalapsk