如何从 Excel 将多个列导入 Access

Question

我正在使用 MS-Access 2003 和 2016 (365)，并且我有一个保存为 csv 的 excel 2016 文件。 excel 文件来自我无法控制且无法标准化的应用程序。他们将某些列用于特定类型，而不用于其他类型，因此输出包含 A 到 XU 列。

excel 文件有超过 255 列。

我想使用单列和第 2 列（部件号）和其他多列加载到多个表中，并允许将部件号链接在一起。

I.E.表一将有部件号，第 1 列，第 3 列，第 4 列 .... 第 200 列。

那么表二将是零件编号，第 201 列，第 202 列.....第 400 列。

然后表三等等等等

直到所有列都被加载（这可以是可变的，但大约 650 列）（当前是 excel 中的 XU 列）。

'The first part
#If Win64 Then '64?
    Private Declare PtrSafe Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As LongPtr, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#Else
    Private Declare Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As Long, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#End If

Sub Insert_PPL()
'
' Insert_PPL Macro
' This copies the PPL external data into the PPL table
       
    Application.ScreenUpdating = False
    Dim MyFile As String
    Dim LastRow As Long

    'Error handling
On Error GoTo Err_Insert

   'MyFile = Application.GetOpenFilename("Excel Files (*.xl*),*.xl*", , "Select TechnoSearch Download File", "Open", False)

    'Workbooks.Open (MyFile)

    Worksheets("PPL").Activate
    Worksheets("PPL").Cells.Select
    Selection.Delete
    
    'Moved the myfile open to after the PPL delete
    MyFile = Application.GetOpenFilename("Excel Files (*.csv*),*.csv*", , "Select TechnoSearch Download CSV File", "Open", False)

    Workbooks.Open (MyFile)
    
    ActiveSheet.Cells.Select
    Selection.Copy
    
    Application.DisplayAlerts = False
    
    ActiveWorkbook.Close
    
    Worksheets("PPL").Select
    ActiveSheet.Range("A1").Select
    Worksheets("PPL").Paste
    
    Application.DisplayAlerts = True
        
    MsgBox ("PPL has been loaded")
    
    Remove_More_Text
    Filter_PPL
    
    Exit Sub

Err_Insert:
    MsgBox Err.Description, vbCritical, Err.Number
    
End Sub

Sub Remove_More_Text()
'
' Remove_More_Text Macro
' Used to remove the additional text in the TechnoSearch File
'

Dim sht As Worksheet
Dim LastRow As Long
Dim rng As Range
Dim str As String
Dim x As Integer
Dim LastWord As String


Set sht = ThisWorkbook.Worksheets("PPL")
    
    Columns("E1:E" + CStr(sht.Rows.Count)).Select
    LastRow=sht.Rows.Count
    For cnt = 2 To LastRow
        Set rng = Range("E" + CStr(cnt))
        
        str = rng.Value
        
        'Get the Character Position of more text
        If InStr(str, "more text") = 0 Then
            x = Len(str) + 3
        ElseIf InStr(str, "more text") < 4 Then
            x = 3
        Else
            x = InStr(str, "more text")
        End If
        
        LastWord = Left(str, x - 3)

        'Replace the original with the shortened string
        rng.Value = LastWord
        Call MsgBoxTimeout(0,cnt&" of "&LastRow,"",vbInformation,0,1)

    Next
    
End Sub

Answer 1

您可以使用 VBA 将 CSV 文件作为文本文件打开，逐行读取，然后根据三个表将其添加到记录集中。类似下面的代码应该会让你朝着正确的方向前进：

Sub sGetWideCSV()
    On Error GoTo E_Handle
    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim rs3 As DAO.Recordset
    Dim strFile As String
    Dim intFile As Integer
    Dim strInput As String
    Dim astrInput() As String
    Dim intLoop1 As Integer
    strFile = "C:\test\data.csv"
    intFile = FreeFile
    Open strFile For Input As intFile
    Set db = CurrentDb
    Set rs1 = db.OpenRecordset("SELECT * FROM tbl1 WHERE 1=2;")
    Set rs2 = db.OpenRecordset("SELECT * FROM tbl2 WHERE 1=2;")
    Set rs3 = db.OpenRecordset("SELECT * FROM tbl3 WHERE 1=2;")
    Do
        Line Input #intFile, strInput
        astrInput = Split(strInput, ",")
        With rs1
            .AddNew
            rs1(0) = astrInput(0)
            For intLoop1 = 1 To 10
                rs1(intLoop1) = astrInput(intLoop1)
            Next intLoop1
            .Update
        End With
        With rs2
            .AddNew
            rs2(0) = astrInput(0)
            For intLoop1 = 1 To 10
                rs2(intLoop1) = astrInput(intLoop1 + 10)
            Next intLoop1
            .Update
        End With
        With rs3
            .AddNew
            rs3(0) = astrInput(0)
            For intLoop1 = 1 To 10
                rs3(intLoop1) = astrInput(intLoop1 + 20)
            Next intLoop1
            .Update
        End With
    Loop Until EOF(intFile)
sExit:
    On Error Resume Next
    rs1.Close
    rs2.Close
    rs3.Close
    Set rs1 = Nothing
    Set rs2 = Nothing
    Set rs3 = Nothing
    Set db = Nothing
    Reset
    Exit Sub
E_Handle:
    MsgBox "sGetWideCSV", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

在上面的示例中，每个记录集我只使用了 10 列，但您应该明白了。如果 CSV 中的最后一列是可变的，那么您将需要处理它（可能在将数据拆分为数组后使用 UBound）。

但是，与其将其读入 Access 并通过使用多个表来解决列限制，不如在阅读时标准化数据几乎肯定是一个更好的主意进去了。

问候，

Answer 2

考虑纯 SQL，因为 Access 可以直接查询 CSV 数据文件（甚至是 Excel 工作簿），就好像它们是表一样：

INSERT INTO myTable1 (PartNumber, Col1, Col2, ..., Col200)
SELECT PartNumber, Col1, Col2, ... Col200
FROM [text;database=C:\Path\To\Folder].myCSVFile.csv AS t;

INSERT INTO myTable2 (PartNumber, Col1, Col2, ..., Col200)
SELECT PartNumber, Col201, Col202, ... Col400
FROM [text;database=C:\Path\To\Folder].myCSVFile.csv AS t;

INSERT INTO myTable3 (PartNumber, Col1, Col2, ..., Col200)
SELECT PartNumber, Col401, Col402, ... Col600
FROM [text;database=C:\Path\To\Folder].myCSVFile.csv AS t;

以上内容可以保存为存储的 Access 查询，并在未来随时使用 DoCmd.OpenQuery "myQueryName" 或 CurrentDb.Execute "myQueryName" 运行，前提是路径、文件名和标题不变。

---

要从 CSV 中快速检索列（对于上述查询，您只需 一次 次）：

1. 在 Excel 中复制所需的 200 个标题批次。
2. 在记事本或其他文本编辑器中粘贴制表符分隔的 CSV 列标题。
3. 将所有制表符 (\t) 替换为逗号和空格 (, )。具体来说，复制任意两个列名之间的不可见空格并运行查找/全部替换 (Ctrl+H)。
   • 如果列有特殊字符或名称，则需要用方括号括起来。所以用右括号、逗号、空格和左括号 (], [) 替换制表符。然后在第一列之前添加一个左括号并在最后一列结束。
4. 复制生成的以逗号分隔的 CSV 列名。
5. 粘贴到查询的SELECT 子句（或INSERT INTO 列，如果标题与表列匹配）。