French Excel Macro issue related to cell formats

Hi There,

I have a strange problem that doesn't appear in the English version of excel.

I have a spreadsheet that has a macro to load data. All the load data macro is meant to do is take from the indicated text file, the information and populate a pre-formatted worksheet.

The text file contains predominantly numbers which when imported into the excel worksheet should be depicted in percentages so 0.1 would be 10%.

What I have observed is that when the number being imported only has one digit after the decimal place (e.g. 0.1) the format of the cell changes from percentage to date and a random date is entered into the cell.

To confirm this was the case, I changed the 0.1 to 0.11 in the text file and then imported the file into the excel sheet using the macro load data and the cell containing that value was correctly showing 11%.

Now of course its going to be a real bind to have to go through the text file and add an extra digit for each number that has only one digit after decimal point so I was hoping that someone here can help?

If you need the macro code I can add it to this forum but i noticed on another post that it is required to add "code tags" so please tell me what you mean by "code tags" if you wish to me to add the code.

Sub loadData()

'Runtime error handling
On Error Resume Next

'Unprotect the password protected sheet for loading csv data
ActiveSheet.Unprotect password:=pass
 
'Variable declaration
Dim strFilePath As String, strFilename As String, strFullPath As String
Dim lngCounter As Long
Dim oConn As Object, oRS As Object, oFSObj As Object
    
'Define Label to be used for error handling
FILE_SELECT:
    'Get a csv file name
     strFullPath = Application.GetOpenFilename("CSV Files (*.csv),*.csv,Text Files (*.txt), *.txt", , "Please select text file...")

    'If strFullPath = "False" Then Exit Sub  'User pressed Cancel on the open file dialog
    If strFullPath = "False" Or strFullPath = "Faux" Then Exit Sub  'User pressed Cancel on the open file dialog

     'Swetha
    Dim LPosition As Integer
    LPosition = InStr(strFullPath, ".csv")
    If (LPosition <> 0) Then
    Workbooks.Open Filename:=strFullPath, Format:=6, delimiter:=","
    Else
    Workbooks.Open Filename:=strFullPath, Format:=6, delimiter:=","
    End If
    
    'Swetha
    'Preprocess the CSV file to remove the report details
    Dim lrow As Integer
    Dim w As Workbook
    Dim NRRowsRange As String, delFile As String
    
    'Workbooks.Open Filename:=strFullPath
    w = ActiveWorkbook.Name
    
    lrow = Application.WorksheetFunction.Match("TAPERIOD", Range("A:A"), 0)
    lrow = lrow - 1
    NRRowsRange = "1:" & lrow
    Rows(NRRowsRange).EntireRow.Select
    Selection.ClearContents
    Application.DisplayAlerts = False
    Selection.Delete Shift:=xlUp
    ActiveWorkbook.SaveAs Filename:= _
        "tmp" _
        , FileFormat:=xlCSV, CreateBackup:=False
    Application.DisplayAlerts = True
    ActiveWorkbook.Close savechanges:=True

    'This gives us a full path name e.g. C:tempfolderfile.txt
    'We need to split this into path and file name
    Set oFSObj = CreateObject("SCRIPTING.FILESYSTEMOBJECT")

    strFilePath = oFSObj.GetFile(strFullPath).ParentFolder.Path
    'strFilename = oFSObj.GetFile(strFullPath).Name
    strFilename = "tmp.csv"

    delFile = strFilePath & "\temp1.csv"
    oFSObj.FileExists (delFile)
    If (oFSObj.FileExists(delFile)) Then
    delete_File (delFile)
    End If

    delFile = strFilePath & "\temp2.csv"
    oFSObj.FileExists (delFile)
    If (oFSObj.FileExists(delFile)) Then
    delete_File (delFile)
    End If
    
    Call Form_Load
        'MsgBox (locInfo)
    If locInfo = "France" Then
          
        'Sub Read_text_File()
        Dim MyFile, sText
        Dim oFS
        Dim LResult As String
        Dim LResult1 As String
        Dim Filename As String
        Filename = "temp1.csv"

        Set oFS = oFSObj.OpenTextFile(strFilename)
        Set MyFile = oFSObj.OpenTextFile(Filename, 8, True)

        Do Until oFS.AtEndOfStream
        sText = oFS.ReadLine
        LResult = Replace(sText, ",", ";")
        LResult1 = Replace(LResult, ".", ",")
        ' Write to the file.
        MyFile.WriteLine LResult1
        Loop
    
        oFSObj.CopyFile "temp1.csv", strFilename, True
        'Close oFS
        Close MyFile
        oFSObj.CopyFile strFilename, "temp2.csv", True
    
        strFilename = "temp2.csv"
   
    Else
        'MsgBox ("Match Found")
        strFilename = "tmp.csv"
    End If
    

    'Clear Previously loaded data except for the DONOT WRITE BELOW THIS Row
    Range("A4", ActiveSheet.Range("A4").End(xlDown)).EntireRow.Select
    Selection.ClearContents
    ActiveSheet.Range("EX828").Value = "DONOT WRITE BELOW THIS"

    'Open an ADO connection to the folder specified
    Set oConn = CreateObject("ADODB.connection")
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & strFilePath & ";" & _
               "Extended Properties=""text;HDR=Yes;FMT=Delimited"""

    Set oRS = CreateObject("ADODB.RECORDSET")
       
    'Now actually open the text file and import into Excel
    oRS.Open "SELECT * FROM " & strFilename & " ORDER BY TAPERIOD", oConn
    On Error GoTo FILE_SELECT_HEADER 'Prevent loading of csv file with no header or with blank line before the header
    
    'Check the no of columns in the csv to be imported
    If (oRS.Fields.Count <> 253) Then
        Style = vbOKOnly + vbCritical + vbDefaultButton2 + vbSystemModal
        Title = "ERROR"
        Response = MsgBox("Missing fields in network kpi report" & vbCrLf & "Select a proper file", Style, Title)
        GoTo FILE_SELECT
    End If

    'Check for blank records in the csv to be imported
    While Not oRS.EOF
        If IsNull(oRS!AP_CNT) Then
            Response = MsgBox("Blank records in network kpi report" & vbCrLf & "Select a proper file", Style, Title)
            GoTo FILE_SELECT
        End If
        oRS.MoveNext
    Wend
    

    'Move the cursor to the first record in the recordset & start loading
    oRS.MoveFirst
    
    While Not oRS.EOF
        ActiveSheet.Range("A4").CopyFromRecordset oRS ' Specifies the location in excel to start copying the data from csv
    Wend

    'Close the recordset & ADO connection
    oRS.Close
    oConn.Close
     
    'Update the graphs in the worksheet
    Call updateGraph(ActiveSheet.Name)
    
    'Password protect the sheet
    ActiveSheet.Protect password:=pass
    
    'Higlight the first cell of the sheet
    Range("A1").Select
    
    ActiveWindow.ScrollRow = 100
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 500
    ActiveWindow.ScrollColumn = 1
    
    Kill strFilename
    'Exit the subroutine to prevent error handling code to be executed in non-error conditions
    Exit Sub
    
'Define Label to be used for error handling
FILE_SELECT_HEADER:
    Response = MsgBox("Header not present in csv" & vbCrLf & "/Blank line before the header" & vbCrLf & "Select a proper file", Style, Title)
    Resume FILE_SELECT

End Sub

Sub delete_File(delFile)
    Kill delFile
End Sub

Private Sub Form_Load()

    'MsgBox "You live in " & GetInfo(LOCALE_SENGCOUNTRY) & " (" & GetInfo(LOCALE_SNATIVECTRYNAME) & ")," & vbCrLf & "and you speak " & GetInfo(LOCALE_SENGLANGUAGE) & " (" & GetInfo(LOCALE_SNATIVELANGNAME) & ").", vbInformation
    locInfo = GetInfo(LOCALE_SENGCOUNTRY)
    
End Sub
Public Function GetInfo(ByVal lInfo As Long) As String
    Dim Buffer As String, Ret As String
    Buffer = String$(256, 0)
    Ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer))
    If Ret > 0 Then
        GetInfo = Left$(Buffer, Ret - 1)
    Else
        GetInfo = ""
    End If
    
End Function

Thanks for reading and even bigger thanks in advance if you are able to help.

Regards,

Nozer