Using Excel VBA to automate Excel, CSV files transfer from Sharepoint library to local or network folder.

Public Sub Sharepoint_To_Local()

Dim ws As Worksheet
Dim dataRange As Range
Dim fileName As String
Dim fileName_From As String
Dim fileName_To As String
Dim fileName_Only As String
Dim downloaded_FilePath As String
Dim latest_filePath As String
Dim str_count As Integer


Dim chromePath As String
Dim url As String

todaysDate = Format(Now, "YYYY-MM-DD")

chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"    '*** Check your chrome.exe location, change accordingly

lastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row


For i = 2 To lastRow

fileName_Sharepoint = Cells(i, 1).Value
fileName_From = Cells(i, 2).Value
fileName_To = Cells(i, 3).Value
fileName_Only = Cells(i, 5).Value


' Download file ( .xlsx , .xlsm , .xls , .csv)
downloaded_FilePath = fileName_From & filaName_Only
Debug.Print downloaded_FilePath

url = fileName_Sharepoint & "&download=1"


Shell (chromePath & " -url -newtab " & url)
Application.Wait (Now + TimeValue("0:00:05"))
SendKeys "{F5}", True
Application.Wait (Now + TimeValue("0:00:15"))


' Get the latest file in the downloads folder
latest_filePath = GetLatestFile(fileName_From)
Debug.Print "latest_filePath" & " ---" & latest_filePath


' Check file name if correct, if str_count > 0 , file name is present in string
str_count = InStr(latest_filePath, fileNameOnly)
Debug.Print str_count

If str_count > 0 Then
final_FileName = RemoveParenthesesAndNumbers(latest_filePath)   ' removed () in file name if any
Debug.Print final_FileName


Dim fso As Object                                               ' Transfer file from Downloads folder to desired folder
Set fso = CreateObject("Scripting.FileSystemObject")
'fso.MoveFileEx final_FileName, fileName_To & fileName_Only
fso.CopyFile final_FileName, fileName_To & fileName_Only, True
fso.DeleteFile final_FileName

Cells(i, 4).Value = "File Transfer successful - " & Now()       ' Update Transfer Status in Excel sheet

Else
Cells(i, 4).Value = "File Transfer Not successful - " & Now()   ' Update Transfer Status in Excel sheet

End If


' Close current active tab
Application.SendKeys "^(w)"




Next i

End Sub


Public Function GetLatestFile(folderPath As String) As String
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim latestFile As String
Dim latestDate As Date


Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)

dateNow = Now()
latestDate = dateNow - TimeSerial(0, 0, 20)
latestFile = ""

Debug.Print "Searching in this folder :   " & folderPath
Debug.Print "Datetime NOW - 20 seconds  :   " & latestDate

For Each file In folder.Files

Debug.Print file.DateLastModified

If file.DateLastModified > latestDate Then

    latestDate = file.DateLastModified

    Debug.Print "latest file found"
    Debug.Print latestDate
    Debug.Print file.Path
    
    GetLatestFile = file.Path
    Exit For
End If



Next file



End Function



Function RemoveParenthesesAndNumbers(inputStr As String) As String
Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.Pattern = "\s\(\d+\)"          ' Matches space folled by parenthesis with number inside . eg (1)
.Global = True
End With

' Remove (numbers)
inputStr = regEx.Replace(inputStr, "")

' Return cleaned latest file name
RemoveParenthesesAndNumbers = inputStr

End Function