使用 VBA 将数据导入 Access



我需要经常以CSV格式生成输出。此文件有 25 列。列顺序需要保持不变,因为文件将用作 ETL 过程的输入。请注意,无法配置 ETL 以查找列标题。

提供给我的数据也是CSV格式。列数可能会更改。它可能在 15 到 50 列之间变化。列顺序也可能更改。一个文件可能有Col A,Col B,Col C,然后另一个文件可能有Col B,Col A,Col D。

输入数据如下:

头:

"Employee","Date","Start","End","Brk","Ord","WEND","TRV","PH200","PH250","T1x5","T1x5P","T2","T2x5","SB2","AL","LL175","COM","LWOP","PERS","PHNW","WCOMP","MKUP","AS","NS","CI","NPAY","COC","KMS","LAFHA","LAFHI","MEAL","MPA","OMA","SMA","Allowances","Approval Status","Branch","Branch Cost Code","Branch Ref. No","Contract","Contract Hours Per Cycle","Detail","Detail Cost Code","Detail Ref. No","Employee Ref. No","Employment Type","Location","Location Cost Code","Location Ref. No","Max Hours Per Period","Pay Group","Pay Level","Role","Role Cost Code","Roster","Shift","Timesheet Comments","Total Bill","Total Cost","Total Hours","Work Type"

数据:

"Smith, John","04/11/2017","12:00","05:00","",10.00,"","","",,"",,"",,"",,"",,"",,"",,3.00,7.00,"",,"",,"",1.00,"",,"",,"MEAL","Approved","Melbourne","","","Admin Officer","70.00","JX526","","1469","948","AT","Melbourne","633","","70.00","","Base","Admin Officer Level 1","7847000","1900-0500","DS","","0.00","351.95","10.00",""

如表所示:

| Employee      | Date          | Start     | End       | Brk   | Ord       | WEND  | TRV   | PH200     | PH250     | T1x5  | T1x5P     | T2    | T2x5  | SB2   | AL    | LL175     | COM   | LWOP  | PERS  | PHNW  | WCOMP     | MKUP  | AS    | NS    | CI    | NPAY  | COC   | KMS   | LAFHA     | LAFHI     | MEAL  | MPA   | OMA   | SMA   | Allowances    | Approval Status   | Branch        | Branch Cost Code  | Branch Ref. No    | Contract          | Contract Hours Per Cycle  | Detail    | Detail Cost Code  | Detail Ref. No    | Employee Ref. No  | Employment Type   | Location      | Location Cost Code    | Location Ref. No  | Max Hours Per Period  | Pay Group     | Pay Level     | Role                      | Role Cost Code    | Roster        | Shift     | Timesheet Comments    | Total Bill    | Total Cost    | Total Hours   | Work Type     |
|-------------  |------------   |-------    |-------    |-----  |-------    |------ |-----  |-------    |-------    |------ |-------    |----   |------ |-----  |----   |-------    |-----  |------ |------ |------ |-------    |------ |------ |------ |----   |------ |-----  |-----  |-------    |-------    |------ |-----  |-----  |-----  |------------   |-----------------  |-----------    |------------------ |----------------   |---------------    |-------------------------- |--------   |------------------ |----------------   |------------------ |-----------------  |-----------    |--------------------   |------------------ |---------------------- |-----------    |-----------    |-----------------------    |----------------   |-----------    |-------    |--------------------   |------------   |------------   |-------------  |-----------    |
| Smith, John   | 04/11/2017    | 12:00     | 05:00     |       | 10.00     |       |       |           |           |       |           |       |       |       |       |           |       |       |       |       |           |       | 3.00  | 7.00  |       |       |       |       |           | 1.00      |       |       |       |       | MEAL          | Approved          | Melbourne     |                   |                   | Admin Officer     | 70.00                     | JX526     |                   | 1469              | 948               | AT                | Melbourne     | 633                   |                   | 70.00                 |               | Base          | Admin Officer Level 1     | 7847000           | 1900-0500     | DS        |                       | 0.00          | 351.95        | 10.00         |               |

由于我找不到任何现成的解决方案,因此我正在尝试使用 Access VBA 创建一个小工具来做到这一点。

在导入端,我尝试了 2 种标准方法:

1. DoCmd.TransferText 
2. CurrentDb.Execute "INSERT INTO " & TableName & " SELECT * FROM " _
& "[TEXT;FMT=Delimited;HDR=YES;database=" & FolderOnly & "].[" & FileOnly & "]")

两者都不是很好。数字四舍五入到最接近的小数。我发现没有办法强制将数据导入为文本。所以现在我正在生成 SQL,所以我可以完全控制数据类型。使用文件系统对象,我可以读取文件。第一步是循环遍历并生成 CREATE TABLE 脚本。VBA拆分函数非常适合逗号作为分隔符:

While Not objTextStream.AtEndOfStream
strLine = objTextStream.ReadLine
'regex.pattern =
If objTextStream.line = 2 And Len(strLine) > 0 Then
strSQL = "CREATE TABLE " & TableName & " ("
header = Split(strLine, ",")
For i = LBound(header) To UBound(header)
strSQL = strSQL & "[" & Replace(Replace(header(i), Chr(34), ""), ".", "") & "] TEXT(255)"
headerLine = headerLine & "[" & Replace(Replace(header(i), Chr(34), ""), ".", "") & "]"
If i <> UBound(header) Then
strSQL = strSQL & ","
headerLine = headerLine & ","
End If
Next i
strSQL = strSQL & ")"
'Debug.Print strSql
DBEngine(0)(0).Execute strSQL
End If
Wend

第二步是生成 INSERT 语句。如下所示:

While Not objTextStream.AtEndOfStream
If objTextStream.line > 2 And Len(strLine) > 0 Then
strSQL = "INSERT INTO " & TableName & " (" & headerLine & ") VALUES ("
line = Split(strLine, """,""") 'Regex??
For i = LBound(line) To UBound(line)
If Nz(line(i)) <> "" Then
strSQL = strSQL & "'" & Replace(Replace(line(i), Chr(34), ""), "'", "''") & "'"
Else
strSQL = strSQL & "''"
End If
If i <> UBound(line) Then strSQL = strSQL & ","
Next i
strSQL = strSQL & ")"
'Debug.Print strSQL
CurrentDb.Execute strSQL
End If
Wend

我被困在这里,因为我无法使用带有逗号作为分隔符的拆分函数。某些字段(如"员工"(包含一个逗号,因为名称以Family_Name First_Name格式输出。我想到了正则表达式,但不确定如何在 VBA 中使用它。任何人都可以提出解决方案吗?

我强烈建议您修复其中一个标准调用以满足您的需求,而不是手动执行所有操作。

使用 ISAM 文本驱动程序是最有前途的 imo。

应将MaxScanRows增加到一个足够大的数字,以扫描足够大的部分,以便它会遇到具有大量小数的数字,或者增加到 0 以使 Access 扫描整个文件。当扫描的行包含的小数位数低于要导入的值时,将进行舍入。

有关初始化文本驱动程序的信息,请参阅此 MSDN 页。请注意,较旧的源可能引用架构.ini文件,但此文件不再存在,设置在当前版本的 Access 的注册表中进行管理。

我就是这样做的:

手动生成架构.ini文件:

Dim objFS, objTextStream
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFS.CreateTextFile(GetFolderFromPath(FileName) & "Schema.ini", True)
objTextStream.WriteLine "[" & GetFileNameFromPath(FileName) & "]"
objTextStream.WriteLine "ColNameHeader = True"
objTextStream.WriteLine "Format = CSVDelimited"
objTextStream.WriteLine "MaxScanRows = 0"
objTextStream.WriteLine "CharacterSet = OEM"
objTextStream.Close
Set objTextStream = Nothing
Set objFS = Nothing

然后将文本文件添加为链接表:

If IsTableExisted(TableName) Then DoCmd.DeleteObject acTable, TableName
Dim tdfNew As TableDef
Set tdfNew = CurrentDb.CreateTableDef(TableName)
tdfNew.Connect = "Text;DATABASE=" & GetFolderFromPath(FileName) & _
";TABLE=" & GetFileNameFromPath(FileName) & ";"
tdfNew.SourceTableName = GetFileNameFromPath(FileName)
CurrentDb.TableDefs.Append tdfNew

最新更新