将 CSV 文件导入 Excel/Dir 功能不起作用答案

【问题标题】：Import CSV files into Excel/ Dir function is not working将 CSV 文件导入 Excel/Dir 功能不起作用
【发布时间】：2017-01-26 21:04:31
【问题描述】：

我使用了这个很棒的资源Import CSV files into Excel，上周它工作得很好，但是这周我不能让它工作。

发生了什么变化？

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

【问题讨论】：

天变了！你得到什么错误/不当行为？
我没有收到任何错误，只是 Dir 不会用任何东西填充 FName。
您是否在工作簿中激活了宏？如果在while 循环上方添加调试消息msgbox(FName) 会得到什么？
是的，宏在工作簿中被激活。我在消息框中得到“”。
这个“”表示文件不在应有的位置。

标签： excel vba csv import

【解决方案1】：

这必须是更改的 Excel“默认”位置，或者您移动了 csv 文件。

只有在当前目录中有文件时，您的宏 Sub ImportAllCSV() 才会起作用。

可以肯定的是，一种解决方案是使用完整路径，例如

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

否则，使用您的公式，FName = Dir("*.csv") 调用 Excel 视为“默认”的目录。这是您进入 File > Open...

时的目录

如果您想确定当前路径，请尝试Re-Initializing "ThisWorkbook.Path"，如下所示：

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

【讨论】：

我把它改成了 directory = ThisWorkbook.Path FName = Dir(directory & "\" & "*.csv") 但是当代码来到 .Refresh BackgroundQuery:=False 我得到一个错误“找不到文本文件来更新这个外部数据字段。检查文件没有被移动或更改名称，然后重试。”
@Mirkaminer 然后你应该检查你的文件的权限：检查你是否有写入权限（并且没有其他进程打开它 - 关闭所有 Excel 实例并只打开你的“宏”工作簿）。
我做过，没用。但是我打开excel然后从excel打开宏文件，而不是通过资源管理器然后它工作得很好。那么，如果我通过在资源管理器中双击它来打开它，我该如何更改代码？
您可以尝试更改当前工作簿：使用Set CurrWB..。查看我的编辑；如果它适合您的需要，请不要犹豫accept it。如果您想进一步改进您的宏，您可以询问其他人。

我使用了您推荐的功能，但没有从

.Refresh BackgroundQuery:=False 行更改故障我得到一个错误“找不到文本文件更新这个外部数据字段。检查文件没有被移动或更改名称，然后重试。”但如果我从 excel 打开文件，我不会收到任何错误消息。

【解决方案2】：

这就是答案

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

【讨论】：