Add information to an Excel file - excel

Question

I've made a VBA macro that allows me to get information from a specific file from a folder.
The format of the name is Name_Timestamp.extension
I get the TimeStamp.
What I need to do: add the Name file in column G, the time stamp in column B and a word in column J to an Excel with headers.
Do you have any Idea on how I can do it ?
Dim Chemin As String, Fichier As String, timeStamp As String
'Définit le répertoire contenant les fichiers
Chemin = "PATH"
Fichier = Dir(Chemin & "*.*")
timeStamp = Split(Fichier, "_")(2)
timeStamp = Split(timeStamp, ".")(0)
Do While Len(Fichier) > 0
MsgBox (Fichier & "___" & timeStamp)
Fichier = Dir
Loop
End Sub

Answer 1

Split by Timestamp
Adjust the values in the constants section.
The Code
Option Explicit
Sub splitByTimeStamp()
Const wsName As String = "Sheet1"
Const FirstRow As Long = 2
Const FolderPath As String = "C:\Test"
Const aWord As String = "a word"
Const TimeStampDelimiter As String = "_" ' don't use a dot ('.').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
Dim pSep As String: pSep = Application.PathSeparator
Dim FileName As String: FileName = Dir(FolderPath & pSep & "*.*")
Dim cRow As Long: cRow = FirstRow
Dim sArr() As String
Dim cString As String
Dim NoStamp As String
Dim TimeStamp As String
Dim n As Long
Application.ScreenUpdating = False
Do While Len(FileName) > 0
sArr = Split(FileName, TimeStampDelimiter)
Select Case UBound(sArr)
Case 0
cString = sArr(0)
NoStamp = Left(cString, InStrRev(cString, ".") - 1)
TimeStamp = ""
Case 1
NoStamp = sArr(0)
cString = sArr(1)
TimeStamp = Left(cString, InStrRev(cString, ".") - 1)
Case Else
For n = 0 To UBound(sArr) - 1
NoStamp = NoStamp & sArr(n) & TimeStampDelimiter
Next n
NoStamp = Left(NoStamp, Len(NoStamp) - Len(TimeStampDelimiter))
cString = sArr(UBound(sArr))
TimeStamp = Left(cString, InStrRev(cString, ".") - 1)
End Select
ws.Cells(cRow, "B").Value = TimeStamp
ws.Cells(cRow, "G").Value = NoStamp
ws.Cells(cRow, "J").Value = aWord
cRow = cRow + 1
FileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Files Found: " & cRow - FirstRow, vbInformation, "Success"
End Sub