0

我有将 csv 文件导入 Access 表的代码。有几个问题或想法超出了我的技能水平。第一个问题是文件不附加现有字段，而是插入整个文件，创建包含新标题的副本。

第二个问题是我只想从 Access 中导出 csv 文件中的新记录或更新记录，而不是整个表，我还没有到那里。

我需要一只小手牵着这里。

谢谢大家，这个论坛，你们是最棒的。总是乐于助人并渴望分享您的知识。

Option Compare Database
Option Explicit

Private Sub ImportFile()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String

Dim xlApp As Object, xlWb As Object, xlWs As Object
Dim lngRow As Long, lngLastRow As Long
Dim rst As DAO.Recordset

strPath = "C:\Transit\"
strTable = "Transit"
strFile = Dir(strPath & "*.csv")

Set rst = CurrentDb.OpenRecordset(strTable)

Do While Len(strFile) > 0

      strPathFile = strPath & strFile

        Set xlApp = CreateObject("Excel.Application")
        Set xlWb = xlApp.Workbooks.Open(strPathFile)
        Set xlWs = xlWb.Worksheets(1)

        lngLastRow = xlWs.UsedRange.Rows.Count

        For lngRow = 1 To lngLastRow

            rst.AddNew
            rst("Field1") = xlWs.Range("A" & lngRow).Value
            rst("Field2") = xlWs.Range("B" & lngRow).Value
            rst("Field3") = xlWs.Range("C" & lngRow).Value
            rst("Field4") = xlWs.Range("D" & lngRow).Value
            rst("Field5") = xlWs.Range("E" & lngRow).Value
            rst("Field6") = xlWs.Range("F" & lngRow).Value
            rst("Field7") = xlWs.Range("G" & lngRow).Value
            rst.Update

        Next

    xlApp.Quit
    Set xlApp = Nothing
    Set xlWb = Nothing
    Set xlWs = Nothing
    strFile = Dir()
Loop

rst.Close
Set rst = Nothing

End Sub
4

2 回答 2

2

我建议为该文件创建一个链接表。完成此操作后，您可以像对待任何其他表一样处理链接的 Excel 文件，包括运行 SELECT 和操作查询。在您的情况下，您可以创建一个以 Excel 电子表格为目标的简单追加查询，并将其限制为仅那些尚未更新的记录。

链接外部 Excel 文件 它也将在查询设计器的添加表对话框中可见。

更新

如果 Excel 文件的路径不固定，则需要一点 VBA 来自动重新链接文件。 

'Defined as a function instead of a Sub
'Allows calling from an AutoExec macro, or setting as an eventhandler property
Public Function Relink(path As String)
    Dim dbs As DAO.Database, tdf As DAO.TableDef
    Dim newConnect As String
    Dim connectParts As Variant, part As Variant, keyValuePair As Variant
    Dim key As String, value As String, delimiterPosition As Integer

    'Objects created from CurrentDb can only be referenced once; after that they cause an error
    'Therefore we need save a reference to the Database object in a variable
    Set dbs = CurrentDb

    'Each table has a corresponding TableDef (table definition) object
    Set tdf = dbs.TableDefs("LinkedSheet")

    'TableDef objects have a Connect property, containing a connection string for linked tables
    '(For non-linked tables this will be a zero-length string)
    'A connection string has the form key=value;key1=value1 etc.
    connectParts = Split(tdf.Connect, ";")
    For Each part In connectParts
        keyValuePair = Split(part, "=")
        If keyValuePair(0) = "DATABASE" Then
            keyValuePair(1) = path
        End If
        newConnect = newConnect & ";" & Join(keyValuePair, "=")
    Next

    'We need to remove the extra semicolon in the beginning
    newConnect = Mid(newConnect, 2)

    'Set the connection string, and save the change by calling RefreshLink
    tdf.Connect = newConnect
    tdf.RefreshLink
End Function
于 2012-11-29T10:01:00.093 回答
1

好的，简短的回答，但稍微抬头，我认为它会有所帮助。

查看DoCmd.TransferText命令。有了它，您可以将 csv 文件导入临时表。您甚至可以选择指定文件是否有标题。它看起来像这样：

DoCmd.TransferText acImportDelim, , "temp", "c:\Transit\myfile.csv", True

一旦将它放在临时表中，您就可以进行查询以查看哪些记录是新的，并将它们附加到您的永久表中。

于 2012-11-29T07:37:30.857 回答