Sub RUN_Per_Dist()
Dim UsdRws As Long
Dim FilePath As String
Dim TestStr As String
Dim FoundFile As Boolean
Dim rws As Long
Dim bottomrow, lastblank As Long
Dim lr As Long
Dim vCols As Variant, vRows As Variant
Dim i As Long, k As Long
Dim ErrMsg As String
Dim ST As Workbook
'Set ST file to close
Set ST = OpenCopyST
Application.ScreenUpdating = False
Application.EnableEvents = False
'find path if not found give msg (NAS Fie)
FilePath = "\\xxxxxxxxxxxxxxxxxxxxxxxxxxxx\" & Format(Now(), "MM-DD-YY") & " " & "Div" & ".xml"
TestStr = Dir$(FilePath)
If TestStr = "" Then
ErrMsg = "NAS File NOT FOUND"
End If
'to close ST if not in use
If Not ST Is Nothing Then
'If found check if ST Exists
[B] If Not OpenCopyST Then[/B]
ErrMsg = ErrMsg & vbCrLf & "ST File NOT FOUND"
End If
'If ST found check if ST file is NOT empty give msg end of VBA if Empty
If Range("A" & rows.count).End(xlUp).row <= 3 Then
Call CLOSEST
ErrMsg = ErrMsg & vbCrLf & "ST File is Empty"
End If
If ErrMsg <> "" Then
MsgBox ErrMsg
Else
'Do stuff (copy paste formulas etc)
'Format ST file and copy into NAS Compare
Cells.Copy
With Workbooks("Nas Compare").Sheets("ST Per Distr")
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Application.CutCopyMode = False
End With
'Close ST file
ST.Close SaveChanges:=False
End If
'other stuff (copy paste formulas etc)
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
Public Function OpenCopyST() As Workbook
Dim sPath As String
Dim sPartial As String
Dim sFName As String
sPath = "\\xxxxxxxxxxx$xxxxxxxx\" ' <<<<< 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
Set OpenCopyST = ActiveWorkbook
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
Sub CLOSEST()
Dim sPath As String
Dim sPartial As String
Dim sFName As String
sPath = "\xxxxxxxxxxxx\" ' <<<<< 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
