VBA Convert from text to excel Format cells change from General to numeric for some rows - vba

Question

I have code which compares two folders (textFiles & ExcelFiles), to find if all textFiles are converted to Excel. If not, it calls a function that does this. Everything works well, but when I open the Excel file, the format may change from a row to another in the same column.
This is my code:
Sub LookForNew()
Dim dTxt As String, dExcel As String, key As String
Dim i As Integer
Dim oFileExcel, tFileExl, oFileExl, fso, filsTxt, filsExcel, fil, exl
Set fso = CreateObject("Scripting.FileSystemObject")
Set filsTxt = fso.GetFolder("C:\txtFiles").Files
Set filsExcel = fso.GetFolder("C:\excelFiles").Files
Set oFileExcel = CreateObject("Scripting.Dictionary")
Set tFileExl = CreateObject("Scripting.Dictionary")
Set oFileExl = CreateObject("Scripting.Dictionary")
i = 0
For Each fil In filsTxt
dTxt = fil.Name
dTxt = Left(dTxt, InStr(dTxt, ".") - 1)
For Each exl In filsExcel
dExcel = exl.Name
dExcel = Left(dExcel, InStr(dExcel, ".") - 1)
key = CStr(i)
oFileExcel.Add dExcel, "key"
i = i + 1
Next exl
If Not (oFileExcel.Exists(dTxt)) Then
Call tgr
End If
Next fil
Set fso = Nothing
End Sub
Sub tgr()
Const txtFldrPath As String = "C:\txtFiles"
Const xlsFldrPath As String = "C:\excelFiles"
Dim CurrentFile As String: CurrentFile = Dir(txtFldrPath & "\" & "*.txt")
Dim strLine() As String
Dim LineIndex As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
While CurrentFile <> vbNullString
LineIndex = 0
Close #1
Open txtFldrPath & "\" & CurrentFile For Input As #1
While Not EOF(1)
LineIndex = LineIndex + 1
ReDim Preserve strLine(1 To LineIndex)
Line Input #1, strLine(LineIndex)
'STRIP TABS OUT AND REPLACE WITH A SPACE!!!!!
strLine(LineIndex) = Replace(strLine(LineIndex), Chr(9), Chr(32))
Wend
Close #1
With ActiveSheet.Range("A1").Resize(LineIndex, 1)
.Value = WorksheetFunction.Transpose(strLine)
'DEFINE THE OPERATION FULLY!!!!
.TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="|"
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveSheet.Copy
ActiveWorkbook.SaveAs xlsFldrPath & "\" & Replace(CurrentFile, ".txt", ".xlsx"), xlOpenXMLWorkbook
ActiveWorkbook.Close False
ActiveSheet.UsedRange.ClearContents
CurrentFile = Dir
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
This is the picture:
The General format cell changes for some records and becomes a number exp: 4'927'027.00 should be 4927027 like the others.
this is the text file lines
And I want to put a msgBox when there's no Files to convert in "LookForNew" function, but I don't know where.

Answer 1

Question 1: I open the Excel file, the format may change from a row to another in the same column.
Answer: The problem probable lies in your text file. Note what row ,column, and value that isn't formatted properly. Next go to that line and column in your text file. You'll most likely see 4,927,027 or "4927027". In either case Excel might mistake it for a string value.
Question 2: I want to put a msgBox when there's no Files to convert in "LookForNew" function, but I don't know where.
Put a counter in your If Files Exist. You should have your MsgBox after you exit your file loop. - Next fil
This line is miss leading:
oFileExcel.Add dExcel, "key"
correct syntax
dictionary.add key, value
Keys are unique identifiers. Before you add a key to a dictionary you should test to see if the key exist
If not oFileExcel.Exists dExcel then oFileExcel.Add dExcel, ""
Values are references to objects or values.
This line adds the exl file object to oFileExcel dictionary
If not oFileExcel.Exists dExcel then oFileExcel.Add dExcel, exl
This line retrieves the value
Set exl = oFileExcel("SomeKey")
The error is being thrown because you are adding the same key twice. The key values are the name of the Excel file without an extension. Example.xls and Example.xlsx will produce the same key.
That being said, there is no need to use a dictionary. Or to do a file loop in tgr().
I better approach would be
Sub Main
For each textfile
basename = get text file basename
xlfile = xlFileDirectory + baseFileName + excel file extension
if not xlfile Exists then call CreateExcelFromTxt f.Path, xlFileName
End Sub
Sub CreateExcelFromTxt( txtFile, xlFileName)
Open txtFile
Build strLine
Create Excel -> xlFileName
Add strLine to xlFileName
run TextToColumns
End Sub
Here is a starter template
Sub LookForNew()
Const xlFileDirectory = "C:\excelFiles\"
Const txtFileDirectory = C:\txtFiles\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim fso, fld , f, xlFileName
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
Set fld = fso.GetFolder(txtFileDirectory)
Set txtFiles = fso.GetFolder(txtFileDirectory).Files
For Each f In txtFiles
baseFileName = Left(f.Name,InStrRev(f.Name,".")-1)
xlFilePath = xlFileDirectory & baseFileName & ".xlsx"
If Not fso.FileExists(xlFilePath ) Then CreateExcelFromText f.Path, xlFileName
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub CreateExcelFromText(txtFileName, xlFileName)
End Sub