【VBA】サーバのファイルをローカルにコピー

Option Explicit

'OutputSheet Header
Enum en
    サーバー上のファイル名 = 1
    ファイル更新時間
    最終行の値
    theEnd = 最終行の値
End Enum

'サーバー（\\ホスト名\D$\work）上の「CSVファイル」を
'サーバのアドレス
Const cstSrv As String = "\\fs\public\20220928"

Public Sub ファイルコピー()
    Dim tmpSh As Worksheet
    Dim tmpBk As Workbook
    Dim Bk As Workbook
    Dim Sh As Worksheet
    Const clCnt As Long = 8 '更新日付の新しい順で「8つ」、
    Const cstLocal As String = "C:\local" 'ローカルの指定の場所「C:\local」へコピーし、

    'Create Temporary
    Call CreateTemporary(tmpBk, tmpSh, Bk, Sh)
    
    Dim lListCounts As Long
    'Get Server File List
    lListCounts = GetServerFileList(tmpSh, cstSrv)
    
    If lListCounts > 0 Then
        Dim lLocalListCnt As Long
        'Edit File List
        lLocalListCnt = EditFileList(Sh, tmpSh, clCnt, lListCounts)
        
        'Copy CSV From Server to LocalFolder
        Call CopyCSVFromServer2LocalFolder(Sh, cstSrv, cstLocal, lLocalListCnt)
        
    '1 枚のシートに以下の情報を出力させたいです｡
    '①ファイル名
    '②ファイルの更新時間
    '③コピーしてきたそれぞのファイルの最終行の値
    '(最終行のセルの位置はファイルによって異なる)
        'Get data at each files' last row
        Call GetDataAtEachFilesLastRow
    End If
    
    
    'End Program
    Call EndProgram(tmpBk, tmpSh, Bk)
End Sub


'Create Temporary
Private Sub CreateTemporary(ByRef tmpBk As Workbook, ByRef tmpSh As Worksheet, ByRef Bk As Workbook, ByRef Sh As Worksheet)
    Set tmpBk = Workbooks.Add
    Set tmpSh = tmpBk.Worksheets(1)
    Set Bk = ThisWorkbook
    Set Sh = Bk.Worksheets(1)       '←ここでCSVを8件だけリストアップするシートを指定してください。
End Sub

'Get Server File List
Private Function GetServerFileList(ByRef tmpSh As Worksheet, ByRef cstSrv As String) As Long
    Dim CSVFiles As Collection
    Set CSVFiles = New Collection
    
    Dim stBuf As String
    Dim cl As Class1
    
    stBuf = Dir(cstSrv & "\" & "*.csv")
    Do While stBuf <> ""
        Set cl = New Class1
        cl.name = stBuf
        cl.FileDateTime = FileDateTime(cstSrv & "\" & stBuf)
        CSVFiles.Add cl, stBuf
        stBuf = Dir()
    Loop
    
    Dim lCnt As Long
    lCnt = CSVFiles.Count
    Dim Var() As Variant
    Dim ii As Long
    
    If lCnt > 0 Then
        ReDim Var(1 To 2, 1 To lCnt)
        For ii = 1 To lCnt
        
            Var(1, ii) = CSVFiles(ii).name
            Var(2, ii) = CSVFiles(ii).FileDateTime
            
        Next ii
        
        With tmpSh
            .Cells(1, 1).Resize(lCnt, 2).Value = WorksheetFunction.Transpose(Var)
        End With
    End If
    
    Set cl = Nothing
    Set CSVFiles = Nothing
    GetServerFileList = lCnt
End Function

'Edit File List
Private Function EditFileList(ByRef Sh As Worksheet, ByRef tmpSh As Worksheet, ByRef clCnt As Long, ByVal lListCounts As Long)
    Dim lRow As Long
    With tmpSh
        .Cells(1, 1).Resize(lListCounts, 2).Sort Key1:=.Cells(1, 2), Order1:=xlDescending
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        If lRow >= clCnt Then
            .Range(Cells(clCnt + 1, 1), .Cells(lRow, 1)).EntireRow.ClearContents
        End If
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Sh.Range(Sh.Cells(5, en.サーバー上のファイル名), Sh.Cells(4 + lRow, en.ファイル更新時間)).Value = .Range(.Cells(1, 1), .Cells(lRow, 2)).Value
    End With
    EditFileList = lRow
End Function

'Copy CSV From Server to LocalFolder
Private Sub CopyCSVFromServer2LocalFolder(ByRef Sh As Worksheet, _
                                            ByRef cstSrv As String, ByRef cstLocal As String, _
                                            ByRef lLocalListCnt As Long)
    Dim ii As Long
    Dim stFileName As String
    With Sh
        For ii = 1 To lLocalListCnt
            stFileName = .Cells(ii + 4, en.サーバー上のファイル名)
            FileCopy cstSrv & "\" & stFileName, cstLocal & "\" & stFileName
        Next ii
    End With
End Sub

'Get data at each files' last row
Public Sub GetDataAtEachFilesLastRow()
    Dim Sh As Worksheet
    Dim FSO As Object
    Dim stBuf As String
    Dim stTarget As String
    Dim lRow As Long
    Dim lLast As Long
    Dim ii As Long
    
    Set Sh = ThisWorkbook.Worksheets(1)     '←リストのあるシート名を指定してください。
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    lRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row

    For ii = 5 To lRow
        stTarget = cstSrv & "\" & Sh.Cells(ii, en.サーバー上のファイル名).Value
        With FSO.OpenTextFile(stTarget, 1)
            stBuf = .ReadAll
            .Close
        End With
        lLast = UBound(Split(stBuf, vbCrLf)) - 1
        Sh.Cells(ii, en.最終行の値).Value = Split(stBuf, vbCrLf)(lLast)
        '↑CSVの仕様が分からないので最終行をまるまるとってくるようにしましたが、
        '特定のカラムだけが必要なら、適切な文字列でSplit関数をかますなどしてください。
    Next ii
    
    Set Sh = Nothing
    Set FSO = Nothing
End Sub
'End Program
Private Sub EndProgram(ByRef tmpBk As Workbook, ByRef tmpSh As Worksheet, ByRef Bk As Workbook)
    Application.DisplayAlerts = False
    tmpBk.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Set tmpSh = Nothing
    Set tmpBk = Nothing
    Set Bk = Nothing
End Sub

Option Explicit

Public name As String
Public FileDateTime As Variant