如何从Excel导入多个列到Access

Question

我使用MS-Access 2003和2016(365)，我有一个excel 2016文件保存为csv。excel文件来自我无法控制的应用程序，无法规范化。它们将一些列用于特定类型，而不用于其他类型，这就是为什么输出有列a到XU的原因。

excel文件超过255列。

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

即表一将有零件编号，第一列，第三列，第四列....列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:testdata.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:PathToFolder].myCSVFile.csv AS t;

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

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

以上可以保存为存储访问查询，并在将来使用DoCmd.OpenQuery "myQueryName"或CurrentDb.Execute "myQueryName"时运行，前提是路径，文件名和头没有改变。

---

从CSV中快速检索列(对于上述查询，您只需要执行一次):

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