一次加载多个CSV文件

How does one import CSV files via Excel VBA in a set, in groups or in multiple individual files, rather than one at a time?

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

6 个解决方案

#1

I am a bit puzzled in that most versions of Excel will open .csv files with out any problems.

我有点困惑的是,大多数版本的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

#2

This will get a file into a one dimensional array quickly

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

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, ",")

Then V contains all the items in a single column, NB first item is V(0)

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

#3

This is another way that avoids the recalc you get when opening a csv file in Excel.

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

Add a blank sheet to your workbook and add the following code the sheet's object

在工作簿中添加一个空白工作表,并将以下代码添加到工作表的对象中

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

You might also want to hide the sheet, so that no one accidentally uses it. Then you can use like this

您可能还想隐藏工作表,以便没有人意外地使用它。然后就可以这样使用了

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

One thing that slightly concerns me is that the Name gets incremented each time you use the function (e.g. data_1, data_2, ...), so there might be a stability issue if these names get saved somewhere.

我有点担心的是,每次使用该函数时,Name都会增加(例如data_1,data_2,...),因此如果这些名称在某处保存,可能会出现稳定性问题。

#4

You could write a simple console application to parse a batch of csv files and save them to excel files.
Not the easiest solution but it could be an option.

您可以编写一个简单的控制台应用程序来解析一批csv文件并将它们保存到excel文件中。不是最简单的解决方案,但它可能是一个选项。

#5

you can also use workbooks.opentext

你也可以使用workbooks.opentext

#6

The idea I had originally was as follows. Given this data

我原来的想法如下。鉴于此数据

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

create three global arrays, called Dog_Names, Dog_Ages and Collar_Size and populate them with the data in the CSV file.

创建三个全局数组,称为Dog_Names,Dog_Ages和Collar_Size,并使用CSV文件中的数据填充它们。

This bit of VBScript does that job and displays the results. Remove the comment mark from the wscript.echo in the x subroutine to see it all happen.

这一点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

The result looks like this

结果看起来像这样

>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

#1