VBA访问：导入带有附加标题数据的CSV

我不熟悉VBA编码。不知道你们能不能帮我？我有一个CSV文件，其结构如下： -前22行包含specfic标题数据，所有数据都在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

这是正确的吗？有人能看出我采取了正确的方法吗

---

更新-重新编码了一点

我对代码中使用多个数组感到有点厌烦，这对我来说非常混乱，因为你到处都在看计数器，所以我想我会为你发布一个替代方案。如果你能按自己的方式去做，你会得到更多的力量，但如果你遇到问题，你可以试试这个。下面的代码要详细得多，但如果您将其交给他人，甚至不得不自己重新编写，并且不知道发生了什么，可能会在将来为您节省时间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注入问题。我在没有持久化数组的情况下做到了这一点。总之，这是值得思考的。祝你好运

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

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

有关更多信息，请参阅

---

编辑：可以更改导入规范以重命名字段等。请参见Access 2007中的导入向导，特别是“高级”对话框。

这就是我的结论：

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

---

嗨，有人能帮忙或建议从哪里开始吗？有人能检查一下这个代码吗。。。在最初的帖子中更新…嗯，不是你做错了，而是我认为你写的代码和执行的SQL比你需要的多得多。请看DoCmd.TransferText。您可以使用一行代码将整个文件引入临时表，然后使用查询和/或DAO从那里处理它。另外，在VBA中讨论字符串连接，因为您的RunSQL命令，除此之外，其他所有操作都不会达到预期效果。看起来更像：插入到主值“&filename&'、”&aryHeader1&'、“&aryBodyi&'”。祝你好运。您好，VBlade，谢谢您的输入，我最初使用的是DoCmd.TransferText，但是由于csv文件的结构原因，这失败了。当我删除头22行数据时，它工作正常。。。但是我需要标题数据，它似乎破坏了DoCmd.TransferText。因此，我试图定制导入程序。完全忘记了连接。谢谢，很公平，这是有道理的。否则，你做事的方式就应该奏效。Print可以帮助您查看是否正在获得预期将输出到调试窗口-Ctrl+G的值。在将动态SQL组合在一起之前，我可能只需要检查并确保您从变量中获得预期值。有时，当代码是SQL字符串时，您会认为它有问题。甚至可能是调试。打印整个SQL字符串，并在查询中运行一行，以确保所有内容都符合犹太标准。但是是的，我想你会很好的。嘿，伙计们，谢谢，我会看看这一点，看看我是否可以让它工作…同时，我改变了我的当前代码见更新在原来的文章，这似乎是工作除了恼人的附加行弹出，似乎不断弹出在每一行被插入的结尾。这种方式可能会更快实际上。。我的代码有性能问题。在表中输入需要一段时间，因为有大量的记录。如何检查vba access中是否存在表？正确的方法不是在access前面，因此语法：公共函数doestableexistrtablename作为布尔Dim db作为DAO。数据库Dim tdf作为DAO.TableDef DoesTableExist=False为db.TableDefs中的每个tdf设置db=CurrentDB如果tdf.Name=strTableName则DoesTableExist=True为End如果下一个设置tdf=Nothing Set db=Nothing End FunctionHi VBlades，您知道如何从vba压缩和加密目录吗？您好，MP24，谢谢，我实际上打算采用这种方法，但是默认的DoCmd.TransferText函数将导入列标题，就像它们在CSV文件中一样。唯一的问题是某些列标题的名称完全相同。。因此需要重新命名。这是我选择自定义导入路径的原因之一。请参阅我的编辑：您可以重命名

---

导入向导中的e字段看起来很吓人，但很高兴您能理解=