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

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