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]

Step #1 - Paste your code into the message post
Step #2 - With the mouse select all the code.
Step #3 - Press the

(VBA) button to wrap the code code tags.
Step#4 - Use the "Preview" button to make sure everything looks right before posting.

 

[mrsushi]

HI, Can you assist with speeding up the below code please?
The code runs really slow. Can this be tweak to speed it up?
Regards
M

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

 

[rlv01]

Thanks for using code tags. The method to speed this up will be similar to the other block of code:

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"
    
    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.
    
    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
    
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
End Sub

 

[mrsushi]

Ma

Thanks for using code tags. The method to speed this up will be similar to the other block of code:

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"
   
    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.
   
    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
   
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
End Sub

Many thanks again for your assistance.
Regards
M