首先，我是VBA的新手。我正在尝试使用VBA，将文本文件导入MS Access表。我的挑战之一是数据并不总是在文本的同一行，但是，数据总是相同的列和空格数。我测试了几个选项，但是，没有任何效率。我有一个旧的数据库，它确实完成了任务，但是，代码被隐藏/锁定，数据库已经过时，因此我尝试重新创建。提前感谢您的任何指导。
这是我的文本文件报告的示例： 数据字段为（NAME，EMP，LVL，CODE1，CODE2，OFCC，COURSE CODE，NARRATIVE，DUR INTVL，STATUS，STATUS DATE，DUE DATE，EVTID）
DATA
TRAINING
INPUT IMAGE
TRAINING SECTION-PAGE: 1
ORG ID: 0001 BRANCH: OFFC1
SERIES/STEP COURSE DUR STATUS DUE
NAME EMP LVL CODE1 CODE2 OFCC CODE NARRATIVE INTVL STATUS DATE DATE EVT-ID
JOINES JAMES 57801 001 000A1 000A1 NIME 000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
PAGE 1
DATA
TRAINING
INPUT IMAGE
TRAINING SECTION-PAGE: 2
ORG ID: 0001 BRANCH: OFFC2
SERIES/STEP COURSE DUR STATUS DUE
NAME EMP LVL CODE1 CODE2 OFCC CODE NARRATIVE INTVL STATUS DATE DATE EVT-ID
GAINES JAMIE 45602 001 000A1 000A1 AIME 000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
PAGE 2
DATA
TRAINING
INPUT IMAGE
TRAINING SECTION-PAGE: 2
ORG ID: 0001 BRANCH: OFFC2
SERIES/STEP COURSE DUR STATUS DUE
NAME EMP LVL CODE1 CODE2 OFCC CODE NARRATIVE INTVL STATUS DATE DATE EVT-ID
JONESY CHADE 12303 001 000A1 000A1 AIME 000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
000001 COURSETITLE 001A *QUAL 01 JAN 17
PAGE 3
这是我尝试用于将文本文件导入MS Access中的表的一个版本的VBA。我有一些我无法弄清楚的错误，所以我不确定自己是否朝着正确的方向前进。
Private Sub Command0_Click()
On Error GoTo Err_Command0_Click
'Requires reference to Microsoft Office 10.0 Object Library or later.
Dim varFile As Variant, db As Database, rec As Recordset
Dim sNAME As String, sEMP As String, sGRD As String
Dim sWC As String, sCOURSECODE As String, sNARRATIVE As String
Dim sSTATUS As String, dSTATUSDATE As Date, dDUEDATE As Date, sEVTID As String
'Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Please select one file to import" 'Set the title of the dialog box.
.Filters.Clear
.Filters.Add "Text files", "*.txt", 1
'Show the dialog box. If the .Show method returns True, the user picked at least one file. If the .Show method returns False, the user clicked Cancel.
If .Show = True Then
For Each varFile In .SelectedItems
Set db = CurrentDb
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from [TMA]"
DoCmd.SetWarnings True
Set rec = db.OpenRecordset("TMA")
Print #2, TextLine
With Text
'NAME
If Trim(Mid(TextLine, 1, 19)) = "" Then
.Cells(CurrentRow, 1) = Name
Else
.Cells(CurrentRow, 1) = Trim(Mid(TextLine, 1, 19))
Name = Trim(Mid(TextLine, 1, 19))
End If
'EMP
If Trim(Mid(TextLine, 21, 5)) = "" Then
.Cells(CurrentRow, 2) = EMP
Else
.Cells(CurrentRow, 2) = Trim(Mid(TextLine, 21, 5))
EMP = Trim(Mid(TextLine, 21, 5))
End If
'GRADE
If Trim(Mid(TextLine, 28, 3)) = "" Then
.Cells(CurrentRow, 3) = GRD
Else
.Cells(CurrentRow, 3) = Trim(Mid(TextLine, 28, 3))
GRD = Trim(Mid(TextLine, 28, 3))
End If
'WORK CENTER
If Trim(Mid(TextLine, 50, 4)) = "" Then
.Cells(CurrentRow, 4) = WC
Else
.Cells(CurrentRow, 4) = Trim(Mid(TextLine, 50, 4))
WC = Trim(Mid(TextLine, 50, 4))
End If
'COURSE CODE
If Trim(Mid(TextLine, 55, 6)) = "" Then
.Cells(CurrentRow, 5) = COURSECODE
Else
.Cells(CurrentRow, 5) = Trim(Mid(TextLine, 55, 6))
COURSECODE = Trim(Mid(TextLine, 55, 6))
'NARRATIVE
If Trim(Mid(TextLine, 62, 28)) = "" Then
.Cells(CurrentRow, 6) = NARRATIVE
Else
.Cells(CurrentRow, 6) = Trim(Mid(TextLine, 62, 28))
NARRATIVE = Trim(Mid(TextLine, 62, 28))
'STATUS
If Trim(Mid(TextLine, 96, 6)) = "" Then
.Cells(CurrentRow, 8) = STATUS
Else
.Cells(CurrentRow, 8) = Trim(Mid(TextLine, 96, 6))
STATUS = Trim(Mid(TextLine, 96, 6))
End If
'STATUS DATE
.Cells(CurrentRow, 9) = STATUSDATE
STATUSDATE = Trim(Mid(TextLine, 104, 9))
End If
'There isn't always a due date so keep going if it's blank
On Error Resume Next
'DUE DATE
.Cells(CurrentRow, 10) = DUEDATE
DUEDATE = Trim(Mid(TextLine, 114, 9))
On Error GoTo 0
'EVENT ID
If Trim(Mid(TextLine, 124, 7)) = "" Then
.Cells(CurrentRow, 4) = EVTID
Else
.Cells(CurrentRow, 4) = Trim(Mid(TextLine, 124, 7))
EVTID = Trim(Mid(TextLine, 124, 7))
End If
rec.AddNew
rec.Fields("NAME") = sNAME
rec.Fields("EMP") = sEMP
rec.Fields("GRD") = sGRD
rec.Fields("WC") = sWC
rec.Fields("COURSE CODE") = sCOURSECODE
rec.Fields("NARRATIVE") = sNARRATIVE
rec.Fields("STATUS") = sSTATUS
rec.Fields("STATUS DATE") = IIf(dSTATUSDATE = #12:00:00 AM#, vbNull, dSTATUSDATE)
rec.Fields("DUE DATE") = IIf(dDUEDATE = #12:00:00 AM#, vbNull, dDUEDATE)
rec.Fields("EVTID") = sEventID
rec.Update
Loop
rec.Close
db.Close
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
Exit_Command0_Click:
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE TMA SET TMA.STATUSDATE = """" WHERE (((TMA.STATUSDATE)=#12/31/1899#));"
DoCmd.RunSQL "UPDATE TMA SET TMA.DUEDATE = """" WHERE (((TMA.DUEDATE)=#12/31/1899#));"
DoCmd.SetWarnings True
Exit Sub
Err_Command0_Click:
MsgBox Err.Number & " " & Err.Description & " Check your Excel File for data consistancy with database structure. Ensure no text in date fields."
End If
If IsNull(rec) Then
rec.Close
End If
db.Close
Resume Exit_Command0_Click
End Sub
答案 0 :(得分：1)
我建议使用获取外部数据 - 文本文件向导首先手动导入文件并在此过程中保存规范文件。您可以在到达向导的最后一步时单击Advanced按钮来执行此操作。
然后，使用随前保存的导入规范名称提供的DoCmd.TransferText方法：
DoCmd.TransferText acImportFixed, "YourSavedSpecification", "YourTableName", "YourTextFilename", True
此表达式中的最后一个参数确定导入是否应该期望输入文件在数据的第一行包含字段名称 - 如果不是这样，则将其设置为false。
答案 1 :(得分：0)
没有你的数据文件的例子，我不能在这里提供任何示例代码，所以我将在psuedo代码中进行讨论。您当前的方法是过滤原始数据文件，这可能很复杂。我的替代方法是：
Import your text file (as-is) into a temporary table.
'// Use some very safe formats so all the text cells come in (e.g. treat all as strings and account for NULL values).
'// doesn't matter if the text in rows you don't care about don't come in cleanly.
Set up a Query to find the rows in this temporary table that meet your filter query.
Use the query result to fill your official table
'// Remember to convert from your safe import format into the data format you want.
这种方法可以模块化（例如，您可以为不同类型的输入文件定制功能）。以下显示了逻辑系列（同样，不是基于可执行代码）：
Function ImportTextFile(InFile as string) As Table
Function FindValidDataRows(TheSource as Table) As Query
Sub AppendtoData(TheQuery as Query)
是的，工作级代码可能与您已有的代码类似，但可维护性和可扩展性大大提高。