Ocicek
New member
- Local time
- Today, 20:08
- Joined
- Jan 19, 2021
- Messages
- 25
Hello MajpNo problem. This is one of those good posts where I learn more from answering than the OP.
I hope you're well since we didn't see communicated

My code is below and I'm sending a couple of sample files attached.
Can you please help me about the issue?
Code:
Function Mb_Al_1()
Dim FSO As Object, objFolder As Object, objFile As Object
Dim OldName As String
Dim NewName As String
Dim FolderPath As String
Dim I As Integer
Dim j As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
'Set objFile = New Scripting.File
On Error GoTo errlog
FolderPath = [Forms]![Payl_Okuma_Veri_Aktarimi_Ana_Form]![MB_Klasor_Konumu] & "\"
Set objFolder = FSO.GetFolder(FolderPath)
For Each objFile In objFolder.Files
If Right(objFile.Name, 3) = "csv" Then
OldName = objFile.Name
j = j + 1
NewName = "Import_" & Format(Date, "yyyymmdd") & "_" & j & ".csv"
' For I = 1 To Len(NewName)
' Debug.Print (Mid(NewName, I, 1)) & " " & Asc(Mid(NewName, I, 1))
' Next I
Debug.Print OldName & " " & NewName
Debug.Print
'Choose to copy
FSO.CopyFile FolderPath & "\" & OldName, FolderPath & "\" & NewName
'choose to rename
'FSO.MoveFile FolderPath & "\" & OldName, FolderPath & "\" & NewName
DoCmd.TransferText acImportDelim, "MB3", "MB_Sheet_Ham", FolderPath & "\" & NewName, False
FSO.DeleteFile FolderPath & "\" & NewName
End If
Next objFile
Exit Function
errlog:
Debug.Print Err.Number & " " & Err.Description & " new name: " & NewName
Resume Next
Set objFile = Nothing
Set objFolder = Nothing
Set FSO = Nothing
End Function