Import CSV files into Excel/ Dir function is not working

Question

I'm used this great resource Import CSV files into Excel, and it was working great last week, but this week i can't get it to work.

What changed?

Sub ImportAllCSV()
  Dim FName As Variant, R As Long
  R = 1
  FName = Dir("*.csv")
  Do While FName <> ""
    ImportCsvFile FName, ActiveSheet.Cells(R, 1)
    R = ActiveSheet.UsedRange.Rows.Count + 1
    FName = Dir
  Loop
  Call KopieraUnikaRaderBlad
  Call RaderaLine
  Call SammanStall
  Call SidforNummer
End Sub

' Sub för att importera csv fil info till blad med namn från filnamnet
Sub ImportCsvFile(FileName As Variant, Position As Range)
Dim newString As String
Dim char As Variant
      ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & FileName _
        , Destination:=Range("$A$1"))
        .Name = "A00-40---1-D02------ Klar_allt"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ' det som är in kopierat några kolumner tas bort
    Columns("C:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    newString = Right(FileName, 25)
    'fixar till bladnamnet
    For Each char In Split(SpecialCharacters, ",")
        newString = Replace(newString, char, "")
    Next
    ActiveSheet.Name = Left(newString, Len(newString) - 3)
End Sub

Answer 1

This is the answer

Sub ImportAllCSV()
  Dim FName As Variant, R As Long
    Application.ScreenUpdating = False
        R = 1
        Set CurrWB = Workbooks("Bok1.xlsm")
        directory = CurrWB.Path & "\"
        FName = Dir(directory & "*.csv")
            Do While FName <> ""
              ImportCsvFile FName, ActiveSheet.Cells(R, 1), directory
              R = ActiveSheet.UsedRange.Rows.Count + 1
              FName = Dir
            Loop

                Call KopieraUnikaRaderBlad
                Call RaderaLine
                Call SammanStall
                Call SidforNummer
                Call KollaFlyttaData
               'Call RäknaData
    Application.ScreenUpdating = True
    End Sub

Sub ImportCsvFile(FileName As Variant, Position As Range, directory As Variant)
Dim newString As String
Dim char As Variant
      ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & directory & FileName _
        , Destination:=Range("$A$1"))
        .Name = "A00-40---1-D02------ Klar_allt" 'vet inte vad den här linjen gör verkar som inget
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .WorkbookConnection.Delete
    End With
    ' det som är in kopierat några kolumner tas bort
    Columns("C:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    newString = Right(FileName, 25)
    'fixar till bladnamnet
    For Each char In Split(SpecialCharacters, ",")
        newString = Replace(newString, char, "")
    Next
    ActiveSheet.Name = Left(newString, Len(newString) - 3)
End Sub

Answer 2

This must be Excel "default" location that changed, or you moved the csv files.

You macro Sub ImportAllCSV() will only work if you have files in the current directory.

To be sure, one solution is to use the complete path, e.g.

fName = "C:\local\my_existing_file.csv"

Otherwise, with your formula, FName = Dir("*.csv") calls to the directory Excel considers as "default". This is the directory you have when going to File > Open...

If you want to be sure of current path, then try Re-Initializing "ThisWorkbook.Path", like with the below:

Set CurrWB = Workbooks("the_current_workbook_you_want.xlsm")
directory = currwb.path
FName = Dir(directory & "\*.csv")