Hej *

Jeg har kopieret en VBA kode, som skal samle mange csv filer i en excel fil fra en mappe. Der er en lille krølle ved det. Hver csv fil har sit unikke navn, dette navn bør sættes ind i kolonne A, kolonne B og C har data.

Jeg fandt som sagt dette link/kode: Passer egemtlig perfekt....men

http://www.mrexcel.com/forum/excel-questions/806636-vba-importing-csv-start-column-b-file-name-column.html" rel="nofollow - http://www.mrexcel.com/forum/excel-questions/806636-vba-importing-csv-start-column-b-file-name-column.html

... når jeg køre koden, så opstår der en fejl. Jeg er ny i VBA og håber der er en, som kan hjælpe og forklare hvad jeg gør forkert. Jeg har tidligere fået super hjælp her i forummet.

Mvh

Bjarne

Svarer værdien af variablen csvFolder - jf kommentaren i fjerde kodelinje - med stien til den mappe, hvor du har dine cvsv filer?

Bedste hilsner

Peter

Hej igen Peter

Uhmm, jeg har lavet en mappe c:\csvfiles\

I den har jeg 3 csv filer.

Skal den "nye" fil have en ny destination/ny mappe, eller?

Er lidt usikker på hvad du mener med værdien af variablen csvFolder?

På forhånd tak.

Mvh

Bjarne

Så prøv at slette ThisWorkbook.Path fra 4.øverste kodelinje, så der blot står:

Prøv at se om det ændrer noget...

uploads/2414/Report.zip" rel="nofollow - uploads/2414/Report.zip

Her er de 3 filer som jeg bruger til test.

Har prøvet at ændre, men nu bliver koden ikke kørt og der kommer ikke nogen fejl. Uhmmm.

Gad vide hvad jeg gør forkert?

Public Sub ImportAllCSV()

    Dim FName As Variant, r As Long
    Dim destCell As Range
    Dim csvFolder As String
   
    csvFolder = "c:\csvfiles\"       'CHANGE THIS FOLDER PATH
    If Right(csvFolder, 1) <> "\" Then csvFolder = csvFolder & "\"
   
    With ActiveSheet
        r = .UsedRange.Row + .UsedRange.rows.Count
        Set destCell = .Cells(r, "B")
    End With
   
    FName = Dir(csvFolder & "*.csv")
    Do While FName <> ""
        r = ImportCsvFile(csvFolder & FName, destCell)
        destCell.Offset(0, -1).Resize(r, 1).Value = FName
        Set destCell = destCell.Offset(r, 0)
        FName = Dir
    Loop
   
End Sub


Private Function ImportCsvFile(FileName As String, Position As Range) As Long
    With Position.Parent.QueryTables.Add(Connection:="TEXT;" & FileName, Destination:=Position)
        .Name = Replace(FileName, ".csv", "")
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlMacintosh
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
        ImportCsvFile = .ResultRange.rows.Count
        .Delete
    End With
End Function

Koden virker fint når jeg tester den, hvis jeg kopierer stien til mappen med csv-filerne fra Windows Explorer.

Selv foretrækker jeg dog normalt at bruge Power Query frem for vba, hvis det handler om at importere csv-filer.

Her er et eksempel der kombinerer alle dine tre csv-filer i et ark, med filnavnet i kolonne A og værdierne i de øbrige kolonner. Ved ikke om det er noget i den stil du søger, men det er ret nemt at variere slutresultatet. Og man skal blot opdatere data for at får nye/ændrede csv-filer med. Jeg har lavet video for at vise fremgangsmåden - den varer lidt under et minut:  http://somup.com/cq1rYRn8Fo" rel="nofollow - http://somup.com/cq1rYRn8Fo

Bedste hilsner

Peter

Hej Peter

Tusinde, tusinde tak for din viden og hjælpsomhed

Super med power query, virker fint. Jeg fik aldrig VBA koden til at virke, men nu kører det hele med PQ og så din "gamle" kode med 0101

Så nu spiller det hele - mange mange tak.

Rigtig god lørdag aften.

Mvh

Bjarne