VBA Excel file attributes

[mrsushi]

Good afternoon,

Is there a way to speed up the below code script? It runs perfectly for what it does, but its terribly slow.

Any advise or an alternative script to that below?

Many thanks
M


Sub GetFileAttributes()
Dim objFSO As Object
Dim objFile As Object
Dim filePath As String
Dim Lastrow As Long
Dim i As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To Lastrow
filePath = Cells(i, 1).Value
If objFSO.FileExists(filePath) Then
Set objFile = objFSO.GetFile(filePath)
Cells(i, 2).Value = objFile.DateCreated
'Cells(i, 3).Value = objFile.DateLastModified
Else
Cells(i, 2).Value = "File not found"
'Cells(i, 3).Value = "File not found"
End If
Next i


Set objFSO = Nothing
Set objFile

 

[rlv01]

Here is something to try, (not tested).

Sub GetFileAttributes()
    Dim objFSO As Object
    Dim filePath As String
    Dim Lastrow As Long
    Dim i As Long
    Dim ST As Single
    
    ST = Timer
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    'Application.EnableEvents = False             <---- use if you have Worksheet_Change event code affected by the cells you are writing to.
    
    With objFSO
        For i = 1 To Lastrow
            filePath = Cells(i, 1).Value
            If .FileExists(filePath) Then
                With .GetFile(filePath)
                    Cells(i, 2).Value = .DateCreated
                    'Cells(i, 3).Value = .DateLastModified
                End With
            Else
                Cells(i, 2).Value = "File not found"
                'Cells(i, 3).Value = "File not found"
            End If
        Next i
    End With
    
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    
    Set objFSO = Nothing
    MsgBox "Elapsed Time: " & Timer - ST
End Sub

(Tip: For future posts , please try to use code tags like I did above when posting code. It makes your code easier to read and copy.

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

)

 

[mrsushi]

Here is something to try, (not tested).

Sub GetFileAttributes()
    Dim objFSO As Object
    Dim filePath As String
    Dim Lastrow As Long
    Dim i As Long
    Dim ST As Single
   
    ST = Timer
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    'Application.EnableEvents = False             <---- use if you have Worksheet_Change event code affected by the cells you are writing to.
   
    With objFSO
        For i = 1 To Lastrow
            filePath = Cells(i, 1).Value
            If .FileExists(filePath) Then
                With .GetFile(filePath)
                    Cells(i, 2).Value = .DateCreated
                    'Cells(i, 3).Value = .DateLastModified
                End With
            Else
                Cells(i, 2).Value = "File not found"
                'Cells(i, 3).Value = "File not found"
            End If
        Next i
    End With
   
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
   
    Set objFSO = Nothing
    MsgBox "Elapsed Time: " & Timer - ST
End Sub

(Tip: For future posts , please try to use code tags like I did above when posting code. It makes your code easier to read and copy.

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

)

That's worked and speeded it up a lot.

The last part of my code finishes off with the below script. Again this is very slow. How would this be amended to speed it up too please?

Regards
M


Sub FileCheck()

Dim myFolder As String
Dim myFileName As String
Dim myRange As Range
Dim myCell As Range
Dim Lastrow As Long

Lastrow = Range("K" & Rows.Count).End(xlUp).Row
Set myRange = Range("K2:K" & Lastrow)
myFolder = "S:\Other\Datafeeds\Cpens"

For Each myCell In myRange
myFileName = myCell.Value
If Dir(myFolder & "\" & myFileName) = "" Then
myCell.Offset(0, -6).Value = "File Doesn't Exist."
Else
myCell.Offset(0, -6).Value = "File Exists."
End If
Next myCell

End Sub

 

[rlv01]

Hi. Can you please re-post your new code using code tags? Thanks.

 

[mrsushi]

The last part of my code finishes off with the below script. Again this is very slow. How would this be amended to speed it up too please?

Regards
M


[Sub FileCheck()

Dim myFolder As String
Dim myFileName As String
Dim myRange As Range
Dim myCell As Range
Dim Lastrow As Long

Lastrow = Range("K" & Rows.Count).End(xlUp).Row
Set myRange = Range("K2:K" & Lastrow)
myFolder = "S:\Other\Datafeeds\Cpens"

For Each myCell In myRange
myFileName = myCell.Value
If Dir(myFolder & "\" & myFileName) = "" Then
myCell.Offset(0, -6).Value = "File Doesn't Exist."
Else
myCell.Offset(0, -6).Value = "File Exists."
End If
Next myCell

End Sub][/CODE]

 

[rlv01]

Is there a reason you continue to ignore my request that you use code tags when posting your code?

 

[mrsushi]

Is there a reason you continue to ignore my request that you use code tags when posting your code?

Sorry, did i not do it properly? Thought i'd clicked on VBA.

Let me try again

 

[mrsushi]

Hows this looking now? I just realised there is a option to preview the code. I think i've placed the code correctly within the tags



[Dim myFolder As String
Dim myFileName As String
Dim myRange As Range
Dim myCell As Range
Dim Lastrow As Long

Lastrow = Range("K" & Rows.Count).End(xlUp).Row
Set myRange = Range("K2:K" & Lastrow)
myFolder = "S:\Other\Datafeeds\Cpens"

For Each myCell In myRange
myFileName = myCell.Value
If Dir(myFolder & "\" & myFileName) = "" Then
myCell.Offset(0, -6).Value = "File Doesn't Exist."
Else
myCell.Offset(0, -6).Value = "File Exists."
End If
Next myCell
][/CODE]

 

[rlv01]

It is very easy to tell whether or not you have successfully added code tags, because with code tags the posted code has a very different look. Notice the different font and
how all keywords are color highlighted .

 

[mrsushi]

It is very easy to tell whether or not you have successfully added code tags, because with code tags the posted code has a very different look. Notice the different font and
how all keywords are color highlighted .

View attachment 107564

Ok, I see. Let me try again.