Question

我是编码VBA的新手。想知道你们是否都可以帮助我？我有一个CSV文件，其结构如下： - 前22行覆盖特定的标题数据（这全部加载在excel的一列中） - 表的列标题位于第23行 - 数据实际上位于第24行以后。

代码需要做的是将这些数据插入到具有正确列标题的新表中。插入时，还需要在表的前几列输入文件名和标题数据。

到目前为止，我已将整个CSV导入到我相信的数组中：

看看我到目前为止：

Sub readCSV()
Dim fs As Object
Dim fso As New FileSystemObject
Dim tsIn As Object
Dim sFileIn, filename As String
Dim aryFile, aryHeader, aryBody As Variant

sFileIn = "C:\doc\test.csv"

Set filename = fso.GetFileName(sFileIn)

Set fs = CreateObject("Scripting.FileSystemObject")
Set tsIn = fs.OpenTextFile(sFileIn, 1)
sTmp = tsIn.ReadAll
aryFile = Split(sTmp, vbCrLf)

For i = 1 To 22
    aryHeader(1, i) = aryFile(i)
Next i

For i = 23 To UBound(aryFile)
    aryBody(i) = Split(aryFile(i), ",")
    DoCmd.RunSQL "INSERT INTO MAINS VALUES (filename,aryHeader(1),aryBody(i))"
Next i

End Sub

这是对的吗？任何人都可以看到我正在采取正确的方法

更新 - 重新编码了一下

Answer 1

我对你的代码中使用多个数组感到有点恼火（这对我来说是非常混乱，无论如何，因为你正在寻找各处的计数器）所以我想我会为你发布一个替代方案。如果你可以按自己的方式行事，给你带来更大的力量，但如果你遇到问题，你可以试试这个。下面的代码更冗长，但是如果你把它交出去，或者甚至不得不自己回到它并且不知道发生了什么（lol），可能会节省你将来的时间：

Sub ReadCSV()
On Error GoTo ErrorHandler    

    Dim db As DAO.Database
    Dim rst As DAO.Recordset

    Dim fso As Scripting.FileSystemObject
    Dim tst As Scripting.TextStream

    Dim strFileName As String
    Dim intCurrentLine As Integer

    Dim strCurrentLine As String
    Dim intHeaderRows As Integer
    Dim strHeader As String
    Dim strHeaderDelimInField As String

    'Consider these your 'constants', so you don't come back to this code in a month
    'and wonder what the random numbers mean.
    intHeaderRows = 22              'Number of header rows in CSV.
    strHeaderDelimInField = "~"     'The character(s) you want to separate each
                                    'header line, in field.

    strFileName = "C:\IrregularCSV.csv"
    intCurrentLine = 1      'Keep track of which line in the file we are currently on.

    'Next two lines get a reference to your table; will add data via DAO and not SQL,
    'to avoid messy dynamic SQL.
    Set db = CurrentDb()
    Set rst = db.OpenRecordset("Mains", dbOpenDynaset)

    Set fso = New Scripting.FileSystemObject
    Set tst = fso.OpenTextFile(strFileName, ForReading)

    'Instead of storing data in arrays, let's go through the file line by line
    'and do the work we need to do.
    With tst
        Do Until .AtEndOfStream
            strCurrentLine = .ReadLine

            If intCurrentLine <= intHeaderRows Then
                strHeader = strHeader & strHeaderDelimInField & strCurrentLine
            Else
                'Add the records via DAO here.
                rst.AddNew
                    'In DAO, rst.Fields("FieldName") are the columns in your table.
                    rst.Fields("FileName") = strFileName

                    'Remove leading delimiter with Right.
                    rst.Fields("HeaderInfo") = Right(strHeader, Len(strHeader) - 1) 

                    'Note that Split always returns a zero-based array
                    'and is unaffected by the Option Base statement.
                    'The way below is less efficient than storing
                    'the return of Split, but also less confusing, imo.
                    rst.Fields("Field1") = Split(strCurrentLine, ",")(0)
                    rst.Fields("Field2") = Split(strCurrentLine, ",")(1)
                    rst.Fields("Field3") = Split(strCurrentLine, ",")(2)
                rst.Update
            End If

            intCurrentLine = intCurrentLine + 1
        Loop
    End With

    tst.Close
    rst.Close

ExitMe:
    Set tst = Nothing
    Set fso = Nothing
    Set rst = Nothing
    Set db = Nothing

    Exit Sub
ErrorHandler:
    Debug.Print Err.Number & ": " & Err.Description
    GoTo ExitMe

End Sub

老实说，我认为你的方式有很多问题。不是说它不起作用，因为我认为它可以，但这种方法更强大。一个意想不到的单引号不会破坏你的工作，使用数据对象来执行插入是不容易（好吧，少，至少）SQL注入问题。我没有持久化数组就完成了它。无论如何，有些值得深思。祝好运。

Answer 2

使用DoCmd.TransferText而不是推出自己的代码：

http://msdn.microsoft.com/en-us/library/office/ff835958%28v=office.15%29.aspx

在导入规范中，您可以设置起始行。

有关详细信息，请参阅Skip first three lines of CSV file (using DoCmd?) in MS Access！

编辑：可以更改导入规范以重命名字段等。请参阅http://www.access-programmers.com/creating-an-import-specification-in-access-2003.aspx（Access 2007中也存在导入向导）和高级专门对话。

Answer 3

这就是我最终的结果：

Sub ReadCSV2()
Dim fs As Object
Dim filename As String
Dim tsIn As Object
Dim sFileIn As String
Dim aryHeader, aryBody As Variant
Dim Text As String
Dim sqlcre As String
Dim sqlsta As String

sFileIn =   "C:\test\test.csv"
filename = GetFilenameFromPath(sFileIn) 'function to get the file name
Set fs = CreateObject("Scripting.FileSystemObject")
Set tsIn = fs.OpenTextFile(sFileIn, 1)

For i = 1 To 23
    Tmps = tsIn.ReadLine
Next i

aryHeader = Split(Tmps, ",")

On Error Resume Next
DoCmd.RunSQL "DROP TABLE tempdata"
On Error GoTo 0

sqlcre = "CREATE TABLE tempdata ([Filename] Text,"
For k = LBound(aryHeader) To UBound(aryHeader)
    sqlcre = sqlcre & "[" & aryHeader(k) & " " & k + 1 & "] Text,"
Next k
k = k - 1
sqlcre = Left(sqlcre, Len(sqlcre) - 13) & ")"
'Debug.Print k
'Debug.Print sqlcre
DoCmd.RunSQL sqlcre
DoCmd.SetWarnings False         
While Not tsIn.AtEndOfStream
     Tmps = tsIn.ReadLine
     aryBody = Split(Tmps, ",")
     sqlsta = "INSERT INTO tempdata VALUES ('" & filename & "','"
     For M = LBound(aryBody) To UBound(aryBody)
         sqlsta = sqlsta & Replace(aryBody(M), "'", "`") & "', '"
     Next M
     M = M - 1
     Debug.Print M
     If M < k Then
         Text = ""
         For i = 1 To (k - M)
             Text = Text & "', '"
         Next i
         sqlsta = sqlsta & Text
     End If
    sqlsta = Left(sqlsta, Len(sqlsta) - 7) & ")"
     'Debug.Print sqlsta
     'Debug.Print k
     DoCmd.RunSQL sqlsta

Wend
DoCmd.SetWarnings True
End Sub

VBA访问：使用其他标头数据导入CSV

3 个答案: