Macro to open CSV file ";" delimited

[cidfidou]

Hi Excel Gods,

I am looking to tweak below VBA code to be able to open X number of CSV file (; delimited) and to have the CSV file in the excel workbook as text (All columns).

The current issue is that all the information per sheet are whitin one col

thanks in advance

Sub test()
Dim myDir As String, fn As String, wb As Workbook
Set wb = ActiveWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then myDir = .SelectedItems(1) & ""
End With
If myDir = "" Then Exit Sub
fn = Dir(myDir & "*.csv")
Do While fn <> ""
With Workbooks.Open(myDir & fn)
.Sheets(1).Copy after:=wb.Sheets(wb.Sheets.Count)
.Close False
End With
fn = Dir
Loop
End Sub

 

[bobsan42]

try this one with .OpenText Method

Sub test25()
    Dim myDir As String, fn As String, wb As Workbook
    Set wb = ActiveWorkbook
    Dim wbt As Object
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & ""
    End With
    If myDir = "" Then Exit Sub
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
        Workbooks.OpenText Filename:=myDir & "\" & fn, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
            ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
            , Space:=False, Other:=False, OtherChar:=";", FieldInfo:=Array(Array(1, _
            2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2) _
            , Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array( _
            15, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2) _
            , Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 2), Array(27, 2), Array(28, 2) _
            , Array(29, 2), Array(30, 2)), TrailingMinusNumbers:=True
            Set wbt = Workbooks(fn)
        With wbt
            .Sheets(1).Copy after:=wb.Sheets(wb.Sheets.Count)
            .Close False
        End With
        fn = Dir
    Loop
End Sub

this is setting text format for the first 30 columns. You can add more if you wish. Will work even if you have less columns.
Depending on your system settings you may run into a problem with Set wbt = Workbooks(fn).
If your system hides the extensions for known file types (e.g. TXT) to handle this automatically some change to the code:

Sub test26()
    Dim myDir As String, fn As String, wb As Workbook
    Set wb = ActiveWorkbook
    Dim wbt As Object
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & ""
    End With
    If myDir = "" Then Exit Sub
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
        Workbooks.OpenText Filename:=myDir & "\" & fn, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
            ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
            , Space:=False, Other:=False, OtherChar:=";", FieldInfo:=Array(Array(1, _
            2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2) _
            , Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array( _
            15, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2) _
            , Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 2), Array(27, 2), Array(28, 2) _
            , Array(29, 2), Array(30, 2)), TrailingMinusNumbers:=True
            Set wbt = Workbooks(fn)
            If wbt Is Nothing Then
                Set wbt = Workbooks(Left(fn, Len(fn) - 4))
            End If
            If Not wbt Is Nothing Then
                With wbt
                    .Sheets(1).Copy after:=wb.Sheets(wb.Sheets.Count)
                    .Close False
                End With
            End If
        fn = Dir
    Loop
End Sub

 

[cidfidou]

Thank you so much. This is exactly what I was looking for. have a nice week end!!!

 

[cidfidou]

Last question. Do you have any idea why the code above now give some of the fields with " " ie "name" when the previous code did not.

Cheers

 

[cidfidou]

Hi Bob,

Thanks again for your help but i have found the way to tweak the code from TextQualifier:=xlNone to TextQualifier:=xlTextQualifierDoubleQuote and it is working like a charm.

 

[bobsan42]

glad you had it fixed - nice weekend, cheers