Modify existing VBA to accommodate opening most recent file

I

ItalianPlatinum

Well-known Member
Joined
Mar 23, 2017
Messages
793
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hello - I am looking for a way to open a file that is the most recent. I have code to open the file if it is a partial file but I have a new issue where there are two versions that were saved and just want the most recent one opened. Is someone able to assist? I would like to use the below still cause it is embedded all over my macro :)

VBA Code: 
Function OpenCopyST() As Boolean
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
   
    sPath = "\\xxxxxx\xxxx$\xxxx\xxxx\xxx xxxx\"      ' <<<<< change accordingly
   
    sPartial = "vi_j_dt_dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"
    sFName = Dir(sPath & sPartial)
    If Len(sFName) > 0 Then
        Workbooks.OpenText sPath & sFName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True
        OpenCopyST = True
    Else
        OpenCopyST = False
    End If
End Function
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
Try this modified code:
VBA Code: 
Function OpenCopyST() As Boolean
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
   
    sPath = "\\xxxxxx\xxxx$\xxxx\xxxx\xxx xxxx\"      ' <<<<< change accordingly
   
    Dim mostRecentDate As String, mostRecentFile As String
    mostRecentDate = ""
    mostRecentFile = ""
    sFName = Dir(sPath & "*.txt")
    While sFName <> vbNullString
        If LCase(sFName) Like "vi_j_dt_dist_????????*.txt" Then
            If Mid(sFName, 14, 8) > mostRecentDate Then
                mostRecentDate = Mid(sFName, 14, 8)
                mostRecentFile = sFName
            End If
        End If
        sFName = Dir
    Wend
    
    If mostRecentFile <> "" Then
        Workbooks.OpenText sPath & mostRecentFile, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True
        OpenCopyST = True
    Else
        OpenCopyST = False
    End If
End Function
 
Upvote 0
If you're looking for the most recent file based on its date/time stamp, you could use the code below. Note the separate function.

VBA Code: 
Function OpenCopyST() As Boolean
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
   
    sPath = "\\xxxxxx\xxxx$\xxxx\xxxx\xxx xxxx\"      ' <<<<< change accordingly

    sPartial = "vi_j_dt_dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"

    sFName = Dir(sPath & sPartial)
    
    Dim arr() As Variant, FullName As String, i As Long
    Do While Len(sFName) > 0
        ReDim Preserve arr(i)
        arr(i) = sPath & sFName
        i = i + 1
        sFName = Dir
    Loop
    
    If i > 0 Then
        FullName = GetMostRecentFileFromArray(arr)
        
        Workbooks.OpenText FullName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True
        OpenCopyST = True
    Else
        OpenCopyST = False
    End If
End Function


Public Function GetMostRecentFileFromArray(ByRef argArr() As Variant) As String
    Dim fso As Object, i As Long, arrEntry As Long, oFile As Object, MostRecentFileDate As Double
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    For i = LBound(argArr) To UBound(argArr)
        Set oFile = fso.GetFile(argArr(i))
        If oFile.DateLastModified > MostRecentFileDate Then
            MostRecentFileDate = oFile.DateLastModified
            arrEntry = i
        End If
    Next i
    GetMostRecentFileFromArray = argArr(arrEntry)
End Function
 
Upvote 0
Actually one more question. would that change my other function of how I close the file? i think it would sorry if I missed that piece in the original part

VBA Code: 
Sub CLOSEST()
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
   
    sPath = "\\xxxxxxx\xxxx$\xxxx\xxxx\xxxxxx\"      ' <<<<< change accordingly
   
    sPartial = "vi_j_dt_dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"
    sFName = Dir(sPath & sPartial)
    If Len(sFName) > 0 Then
        Workbooks(sFName).Close SaveChanges:=False
    Else
    End If
End Sub
 
Upvote 0
You don't need a function for closing your file if you amend the declaration of your function that opens the file:

Rich (BB code): 
Function OpenCopyST() As WorkBook
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
   
    sPath = "\\xxxxxx\xxxx$\xxxx\xxxx\xxx xxxx\"      ' <<<<< change accordingly

    sPartial = "vi_j_dt_dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"

    sFName = Dir(sPath & sPartial)
    
    Dim arr() As Variant, FullName As String, i As Long
    Do While Len(sFName) > 0
        ReDim Preserve arr(i)
        arr(i) = sPath & sFName
        i = i + 1
        sFName = Dir
    Loop
    
    If i > 0 Then
        FullName = GetMostRecentFileFromArray(arr)
        
        set OpenCopySt = Workbooks.OpenText(FullName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True)
    End If
End Function


Usage example:
VBA Code: 
Sub Example()
    Dim MyWorkbook As Workbook
    Set MyWorkbook = OpenCopyST
    
    If Not MyWorkbook Is Nothing Then
        '
        ' do some stuff ...
        '
        ' almost finished
        '
        MyWorkbook.Close SaveChanges:=False
    End If
End Sub
 
Upvote 0
GWteB said:
You don't need a function for closing your file if you amend the declaration of your function that opens the file:

Rich (BB code): 
Function OpenCopyST() As WorkBook
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
  
    sPath = "\\xxxxxx\xxxx$\xxxx\xxxx\xxx xxxx\"      ' <<<<< change accordingly

    sPartial = "vi_j_dt_dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"

    sFName = Dir(sPath & sPartial)
   
    Dim arr() As Variant, FullName As String, i As Long
    Do While Len(sFName) > 0
        ReDim Preserve arr(i)
        arr(i) = sPath & sFName
        i = i + 1
        sFName = Dir
    Loop
   
    If i > 0 Then
        FullName = GetMostRecentFileFromArray(arr)
       
        set OpenCopySt = Workbooks.OpenText(FullName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True)
    End If
End Function


Usage example:
VBA Code: 
Sub Example()
    Dim MyWorkbook As Workbook
    Set MyWorkbook = OpenCopyST
   
    If Not MyWorkbook Is Nothing Then
        '
        ' do some stuff ...
        '
        ' almost finished
        '
        MyWorkbook.Close SaveChanges:=False
    End If
End Sub
Click to expand...
ahhhh Nice ty. the way I do it is the way more complicated way i like yours better
 
Upvote 0
OK, thanks for the feedback. About our submissions regarding your original request, did they meet your needs?
 
Upvote 0
I am getting a compile error type mismatch at this line

VBA Code: 
    Set MyWorkbook = OpenCopyST
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Modifying Existing VBA to open file for yesterday not today
2
Replies
16
Views
914
ItalianPlatinum
I
I
  • Solved
Set value for range being copied over with VBA
2
Replies
14
Views
181
ItalianPlatinum
I
S
  • Question
VBA Code - Message Box "If file exists"
Replies
9
Views
444
Spaztic
S
L
  • Question
Open different date of text file
Replies
5
Views
94
Joe4
Joe4
H
  • Question
Macro to download zip, unpack and copy data
Replies
0
Views
72
HeinrichPaul
H

Forum statistics

Threads
1,214,813
Messages
6,121,706
Members
449,048
Latest member
81jamesacct

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top