导入 CSV，而不将数据格式化为日期和数字

Question

我正在尝试制作一个宏，让用户可以使用 UTF8 编码从 CSV 导入数据，并将所有列定义为文本（Excel 通常假定相关数据是日期和数字）。我的代码如下，

Sub Macro1()

    Const sName As String = "9 1copy"
    Dim strFile As String
    strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select text file...")
    
    On Error GoTo delQuery
        ThisWorkbook.Queries.Add Name:="9 1copy", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(File.Contents(strFile),[Delimiter="","", Columns=64, Encoding=65001, QuoteStyle=QuoteStyle.Csv])," & Chr(13) & "" & Chr(10) & "    #""Change Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}, {""Column6" & _
        """, type text}, {""Column7"", type text}, {""Column8"", type text}, {""Column9"", type text}, {""Column10"", type text}, {""Column11"", type text}, {""Column12"", type text}, {""Column13"", type text}, {""Column14"", type text}, {""Column15"", type text}, {""Column16"", type text}, {""Column17"", type text}, {""Column18"", type text}, {""Column19"", type text}, {""C" & _
        "olumn20"", type text}, {""Column21"", type text}, {""Column22"", type text}, {""Column23"", type text}, {""Column24"", type text}, {""Column25"", type text}, {""Column26"", type text}, {""Column27"", type text}, {""Column28"", type text}, {""Column29"", type text}, {""Column30"", type text}, {""Column31"", type text}, {""Column32"", type text}, {""Column33"", type t" & _
        "ext}, {""Column34"", type text}, {""Column35"", type text}, {""Column36"", type text}, {""Column37"", type text}, {""Column38"", type text}, {""Column39"", type text}, {""Column40"", type text}, {""Column41"", type text}, {""Column42"", type text}, {""Column43"", type text}, {""Column44"", type text}, {""Column45"", type text}, {""Column46"", type text}, {""Column47" & _
        """, type text}, {""Column48"", type text}, {""Column49"", type text}, {""Column50"", type text}, {""Column51"", type text}, {""Column52"", type text}, {""Column53"", type text}, {""Column54"", type text}, {""Column55"", type text}, {""Column56"", type text}, {""Column57"", type text}, {""Column58"", type text}, {""Column59"", type text}, {""Column60"", type text}, {" & _
        """Column61"", type text}, {""Column62"", type text}, {""Column63"", type text}, {""Column64"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Change Type"""
    On Error GoTo 0
    
    ThisWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""9 1copy"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [9 1copy]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "_9_1copy"
        .Refresh BackgroundQuery:=False
    End With
    ActiveSheet.ListObjects("_9_1copy").ShowHeaders = False
    ActiveSheet.ListObjects("_9_1copy").ShowTableStyleRowStripes = False
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Exit Sub
delQuery:
        Dim v
        For Each v In ActiveWorkbook.Queries
            If v.Name = sName Then _
                v.Delete
                Resume
        Next v
        MsgBox "Error No: " & Err.Number & vbLf & Err.Description
    Stop
    
End Sub

运行代码时遇到错误

“运行时错误 1004：应用程序定义或对象定义错误”

上线

.ListObject.DisplayName = "_9_1copy"

在调试时突出显示。 你能帮我修复代码并让我知道我做错了什么吗？

Answer 1

感谢大家投入时间和贡献。问题是我使用 VBA 存储在变量中的文件路径无法传递到公式中，因为公式是一个强大的查询。解决方法是将文件路径值存储在工作表的一个单元格中，然后将该单元格作为参数引用到 power 查询公式中。

工作代码如下。

Sub importtext ()

    ' Part 1 of the code starts. Imports CSV in Text Format.
    
    ' Make Parameter table
    ActiveWorkbook.Names.Add Name:="Filepath", RefersToR1C1:="=Sheet1!R1C66"
    
    ' Ask for source file
    StrFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select text file...")
    ' checks to make sure the user hasn't canceled the dialog.
    If StrFile = "False" Then
    MsgBox "No input file was selected. Process Aborted."
    End
    Else
    ' Put Value in parameter table so that we could pass it in power query.
    Range("BN1").Value = StrFile
    End If
    
    'Create a New Active Query, define the formula.
    SourceFormula = "let" & Chr(13) & "" & Chr(10) & "  Filepath = Excel.CurrentWorkbook(){[Name=""Filepath""]}[Content]{0}[Column1]," & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(File.Contents(Filepath),[Delimiter="","", Columns=64, Encoding=65001, QuoteStyle=QuoteStyle.Csv])," & Chr(13) & "" & Chr(10) & "    #""Change Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}, {""Column6" & _
            """, type text}, {""Column7"", type text}, {""Column8"", type text}, {""Column9"", type text}, {""Column10"", type text}, {""Column11"", type text}, {""Column12"", type text}, {""Column13"", type text}, {""Column14"", type text}, {""Column15"", type text}, {""Column16"", type text}, {""Column17"", type text}, {""Column18"", type text}, {""Column19"", type text}, {""C" & _
            "olumn20"", type text}, {""Column21"", type text}, {""Column22"", type text}, {""Column23"", type text}, {""Column24"", type text}, {""Column25"", type text}, {""Column26"", type text}, {""Column27"", type text}, {""Column28"", type text}, {""Column29"", type text}, {""Column30"", type text}, {""Column31"", type text}, {""Column32"", type text}, {""Column33"", type t" & _
            "ext}, {""Column34"", type text}, {""Column35"", type text}, {""Column36"", type text}, {""Column37"", type text}, {""Column38"", type text}, {""Column39"", type text}, {""Column40"", type text}, {""Column41"", type text}, {""Column42"", type text}, {""Column43"", type text}, {""Column44"", type text}, {""Column45"", type text}, {""Column46"", type text}, {""Column47" & _
            """, type text}, {""Column48"", type text}, {""Column49"", type text}, {""Column50"", type text}, {""Column51"", type text}, {""Column52"", type text}, {""Column53"", type text}, {""Column54"", type text}, {""Column55"", type text}, {""Column56"", type text}, {""Column57"", type text}, {""Column58"", type text}, {""Column59"", type text}, {""Column60"", type text}, {" & _
            """Column61"", type text}, {""Column62"", type text}, {""Column63"", type text}, {""Column64"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Change Type"""
    
    'Add that new query to the workbook. If another query with same name exists, delete that.
    On Error GoTo delQuery
    ActiveWorkbook.Queries.Add Name:=QueryName, _
                               Formula:=SourceFormula, _
                               Description:="This query will import all values in text format to prevent unwanted conversion of dates and numbers."
    On Error GoTo 0
    
    'Create the connection string
    ConnStr = "OLEDB;" & _
              "Provider=Microsoft.Mashup.OleDb.1;" & _
              "Data Source=$Workbook$;" & _
              "Location=""sourcecsv"";" & _
              "Extended Properties="""""
            
    'Add a Query Table to our Worksheet
    With ActiveSheet.ListObjects.Add(SourceType:=xlSrcExternal, _
                                LinkSource:=True, _
                                Source:=ConnStr, _
                                Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [sourcecsv]")
    .Refresh BackgroundQuery:=False
    End With

    ' Delete extra header row that is added while importing.
    ActiveSheet.ListObjects(1).ShowHeaders = False
    ActiveSheet.ListObjects(1).ShowTableStyleRowStripes = False
    Rows(1).EntireRow.Delete

' exit sub. Anything to be done after import should be before this comment.
Exit Sub

' Deletes query if there exists a query with the same name while we perform 1st part of the code.
delQuery:
        Dim v
        For Each v In ActiveWorkbook.Queries
            If v.Name = QueryName Then _
                v.Delete
                Resume
        Next v
        MsgBox "Error No: " & Err.Number & vbLf & Err.Description
    Stop
    
End Sub

end sub

Answer 2

请使用下一个更简单的代码，能够打开包含所有字段的 csv/txt 文件作为文本：

Sub testOpenAsText()
  Dim wb As Workbook, strFile As String
  Dim arrFlInf As Variant, i As Long, NrCol As Long
  
  NrCol = 5 'csv number of columns
  'If the number of columns is variable, the document can be opened twice, 
  'first time only counting the columns number, and second time As Text for the found number of columns...
  ReDim arrFlInf(1 To NrCol)
  For i = 1 To UBound(arrFlInf)
    arrFlInf(i) = Array(i, 2) 'Array(x, 2) means to be open AS TEXT, where x is the column number
  Next
  
  strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select CSV file...")

  Workbooks.OpenText fileName:=strFile, origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Comma:=False, Local:=False, FieldInfo:=arrFlInf
        
  Set wb = ActiveWorkbook 'do whatever you need with the document open with all its fields as Text...
End Sub

它假定文件类型是逗号分隔的。它可以很容易地适应任何定界符...请确认它以文本形式打开您的文档，而不是根据本地化解释日期字段。