CSV to EXCEL issue with special characters in the CSV File

Hi I am presently trying to get a CSV file imported into excel. The CSV file has a number of columns and one of these columns holds string of data. In this string of data I have found the character " which is causing problems when imported to excel, the remainder of the line is being ignored. Can you please help.

See code below!

Thanks
Des

Sub Fill_Report()
'Imports text file into Excel workbook using ADO.
'If the number of records exceeds 65500 then it splits it over more than one sheet.

    Dim strFilePath As String, strFilename As String, strFullPath As String
    Dim lngCounter As Long
    Dim oConn As Object, oRS As Object, oFSObj As Object
    Dim counter As Integer

    'Get a text file name
    strFullPath = Application.GetOpenFilename("CSV Files (*.csv),*.csv", , "Please select CSV file...")

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

    '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
   
   
    counter = ActiveWorkbook.Worksheets.count + 1
   
    '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=No;FMT=Delimited", ""

    Set oRS = CreateObject("ADODB.RECORDSET")
 
    'Now actually open the text file and import into Excel
    oRS.Open "SELECT * FROM " & strFilename, oConn, 3, 1, 1
   
    While Not oRS.EOF
        Worksheets.Add(After:=Worksheets(Worksheets.count)).Name = "Sheet" & counter
     
      'Add Column Headings to Each Page
        ActiveSheet.Cells(1, 1) = "PROC PERIOD"
        ActiveSheet.Cells(1, 2) = "AGENT ID"
        ActiveSheet.Cells(1, 3) = "AGENT NAME"
        ActiveSheet.Cells(1, 4) = "BATCH NAME"
        ActiveSheet.Cells(1, 5) = "BATCH NUM"
        ActiveSheet.Cells(1, 6) = "PRODUCT"
        ActiveSheet.Cells(1, 7) = "PRODUCT VERSION"
        ActiveSheet.Cells(1, 8) = "SCH CODE"
        ActiveSheet.Cells(1, 9) = "POLICY NUMBER"
        ActiveSheet.Cells(1, 10) = "TRANS TYPE"
        ActiveSheet.Cells(1, 11) = "POL REN"
        ActiveSheet.Cells(1, 12) = "POL REF"
        ActiveSheet.Cells(1, 13) = "SALES BRANCH"
        ActiveSheet.Cells(1, 14) = "NUM INSURED"
        ActiveSheet.Cells(1, 15) = "NATIONAL ID"
        ActiveSheet.Cells(1, 16) = "NAME"
        ActiveSheet.Cells(1, 17) = "STR"
        ActiveSheet.Cells(1, 18) = "POST CODE"
        ActiveSheet.Cells(1, 19) = "TOWN"
        ActiveSheet.Cells(1, 20) = "DOB"
        ActiveSheet.Cells(1, 21) = "IN DATE"
        ActiveSheet.Cells(1, 22) = "GR PREM"
        ActiveSheet.Cells(1, 23) = "NET PREM"
        ActiveSheet.Cells(1, 24) = "TAX"
        ActiveSheet.Cells(1, 25) = "COMMISSION"
        ActiveSheet.Cells(1, 26) = "POL TERM"
        ActiveSheet.Cells(1, 27) = "FIN TERM"
        ActiveSheet.Cells(1, 28) = "FIN AG TAR"
     
        ' Setting up Date Columns
        Range("T2:T65536").Select
        Selection.NumberFormat = "d-mmm-yy"
       
        Range("U2:U65536").Select
        Selection.NumberFormat = "d-mmm-yy"
     
        ' Setting up Date Columns
        Range("Q2:Q65536").Select
        Selection.NumberFormat = "@"
       
       
        ' Put Colour and Bold around the Heading Line
        Range("A1:AB1").Select
        With Selection.Interior
            .ColorIndex = 36
            .Pattern = xlSolid
        End With
        Selection.Font.ColorIndex = 5
        Selection.Font.Bold = True
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
   
     
        ActiveSheet.Range("A2").CopyFromRecordset oRS, 65530
       
        ' Set Autofit on for each of the columns on each of the sheets.
        Dim i#
        If ActiveWindow.SelectedSheets.count > 1 Then
            For i = 1 To ActiveWindow.SelectedSheets.count
                ActiveWindow.SelectedSheets(i).Cells.EntireColumn.AutoFit
            Next
        Else
            Cells.EntireColumn.AutoFit
        End If

         Range("A1:AB1").Select
    With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 5
    Selection.Font.Bold = True
                   
        counter = counter + 1
    Wend
   
    Worksheets("Sheet1").Activate
   
    ActiveSheet.Buttons("saveButton").Enabled = True
    ActiveSheet.Buttons("closeButton").Enabled = True
    ActiveSheet.Buttons("saveWorkBook").Enabled = True
   
   
    oRS.Close
    oConn.Close
End Sub


Start Free Trial