我正在尝试制作一个宏，让用户可以使用 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"
在调试时突出显示。 您能帮我修复代码并让我知道我做错了什么吗？
请使用下一个更简单的代码，能够打开包含所有字段的 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
假设文件类型以逗号分隔。它可以轻松适应任何分隔符...请确认它将您的文档作为文本打开，而不根据本地化解释日期字段。
感谢大家投入的时间和贡献。问题是我使用 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
xlsObj=CreateObject("Excel.Application");
xlsObj.Visible = 0;
xlsObj.ScreenUpdating = 0;
xlsObj.EnableEvents = 0;
xlsObj.DisplayAlerts = 0;
xlsObj.DecimalSeparator = ".";
xlsObj.ThousandsSeparator = "";
xlsObj.UseSystemSeparators = 0;
xlsOpenFile = xlsObj.Workbooks.Open(strFileName,0,1);