如何通过Excel VBA一次加载多个CSV文件?

如何通过Excel中的VBA将CSV文件导入到一个集合,多个组或多个单独的文件中,而不是一次导入一个?

我有点困惑,因为大多数版本的Excel将打开.csv文件没有任何问题。

strPath = "C:\Docs\" strFile = Dir(strPath & "*.csv") Do While strFile <> "" Workbooks.Open Filename:=strPath & strFile ActiveWorkbook.SaveAs Filename:=strPath & Mid(strFile, 1, InStr(strFile, ".") - 1) _ & "Conv.xls", FileFormat:=xlNormal strFile = Dir Loop 

这将迅速将文件转换为一维数组

 Open "myfile.csv" For Input As 1 Dim Txt As String Txt = Input(LOF(1), 1) Close #1 Dim V As Variant V = Split(Txt, ",") 

然后V包含在一个单列中的所有项目,注意第一项是V(0)

这是避免在Excel中打开csv文件时得到的重新计算的另一种方法。

将一个空白工作表添加到您的工作簿并添加下面的代码工作表的对象

 Function getCsv(fn) Dim d, scrup As Boolean scrup = Application.ScreenUpdating Application.ScreenUpdating = False With Me.QueryTables.Add( _ Connection:="TEXT;" & fn, _ Destination:=Me.Range("A1") _ ) .Name = "data" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .TextFilePromptOnRefresh = False .TextFilePlatform = 850 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileCommaDelimiter = True .Refresh BackgroundQuery:=False End With d = Me.Names(1).RefersToRange.Value Me.Names(1).Delete Me.UsedRange.Rows.Delete Application.ScreenUpdating = scrup getCsv = d End Function 

您可能还想隐藏纸张,以免没有人意外使用它。 那么你可以这样使用

 dim d d = getCsv("C:\temp\some.csv") 

有一点我关心的是,每次使用函数(例如data_1,data_2,…)时,名称都会增加,所以如果这些名称保存在某个地方,可能会出现稳定性问题。

您可以编写一个简单的控制台应用程序来parsing一批csv文件并将其保存为excel文件。
不是最简单的解决scheme,但它可能是一个选项。

你也可以使用workbooks.opentext

我原本的想法如下。 给出这个数据

 Dog Names,Dog Ages,Collar Size Woof,3,4 Bowser,2,5 Ruffy,4.5,6 Angel,1,7 Demon,7,8 Dog,9,2 

创build三个全局数组,名为Dog_NamesDog_AgesCollar_Size ,并使用CSV文件中的数据填充它们。

这一点VBScript做这个工作,并显示结果。 从x子例程中的wscript.echo中删除注释标记以查看全部情况。

 Option Explicit Dim FSO Set FSO = CreateObject( "Scripting.FileSystemObject" ) Dim oStream Dim sData Dim aData Set oStream = fso.OpenTextFile("data.csv") sData = oStream.ReadAll aData = Split( sData, vbNewLine ) Dim sLine sLine = aData(0) Dim aContent aContent = Split( sLine, "," ) Dim aNames() Dim nArrayCount nArrayCount = UBound( aContent ) ReDim aNames( nArrayCount ) Dim i For i = 0 To nArrayCount aNames(i) = Replace( aContent( i ), " ", "_" ) x "dim " & aNames(i) & "()" Next For j = 0 To nArrayCount x "redim " & aNames(j) & "( " & UBound( aData ) - 1 & " )" Next Dim j Dim actual actual = 0 For i = 1 To UBound( aData ) sLine = aData( i ) If sLine <> vbnullstring Then actual = actual + 1 aContent = Split( sLine, "," ) For j = 0 To nArrayCount x aNames(j) & "(" & i - 1 & ")=" & Chr(34) & aContent(j) & Chr(34) Next End If Next For j = 0 To nArrayCount x "redim preserve " & aNames(j) & "(" & actual - 1 & ")" Next For i = 0 To actual - 1 For j = 0 To nArrayCount x "wscript.echo aNames(" & j & ")," & aNames(j) & "(" & i & ")" Next Next Sub x( s ) 'wscript.echo s executeglobal s End Sub 

结果看起来像这样

 >cscript "C:\Documents and Settings\Bruce\Desktop\datathing.vbs" Dog_Names Woof Dog_Ages 3 Collar_Size 4 Dog_Names Bowser Dog_Ages 2 Collar_Size 5 Dog_Names Ruffy Dog_Ages 4.5 Collar_Size 6 Dog_Names Angel Dog_Ages 1 Collar_Size 7 Dog_Names Demon Dog_Ages 7 Collar_Size 8 Dog_Names Dog Dog_Ages 9 Collar_Size 2 >Exit code: 0 Time: 0.338