Question

我正在将一系列CSV文件导入Access表。我有以下行导入每个文件：

    DoCmd.TransferText acImportDelim, , FN, F.Path, True

此import语句可以工作并创建必要的表。但是，它会根据数据创建字段类型，并且根据数据的前几行，它可能会创建一个字段作为应该是文本的数字 - 然后在文件中遇到文本值时会导致错误。 / p>

如何为输入文件中的每个字段强制字段类型为Text？我以前使用过导入规格，但首先文件格式（由我控制之外的其他人提供）可能会不时更改，其次是200+列的非常“宽”文件，所以这不是一个实际的答案

Answer 1

这不是一个很好的解决方法，但我还是要经历这个过程才能绕过表格中的255个字段限制。简而言之，我最终得到的导入步骤是

将文件的第1行作为输入流
拆分该行以获取字段名称，将它们放入数据字典表中，然后手动标记我要导入的字段
使用CREATE TABLE创建一个新数据表（仅限选定字段），并将所有字段设置为TEXT
读取文件的每一行作为输入流
拆分该行以获取每个字段的数据
使用INSERT INTO将所选字段添加到数据表

很麻烦，但它解决了这两个问题 - 我不限于输入文件中的255个字段，我可以在创建字段时控制字段的数据类型。

代码，如果有人关心，是

Function Layout()

Set db = CurrentDb()
Folder = DLookup("[data folder]", "folder")
Dim FSO As New FileSystemObject
Set flist = FSO.GetFolder(Folder).Files
db.Execute ("delete * from [data dictionary]")

For Each F In flist
    FN = Left(F.Name, InStr(F.Name, ".") - 1)
    FT = Mid(F.Name, InStr(F.Name, ".") + 1)
    If FT <> "csv" Then GoTo Skip

    If TestFile(F.path) = "ASCII" Then
        Set instream = FSO.OpenTextFile(F.path, ForReading, , 0)
        Else: Set instream = FSO.OpenTextFile(F.path, ForReading, , -1)
        End If

    header = instream.ReadLine
    Data = Split(header, ",")
    For i = LBound(Data) To UBound(Data)
        SQL = "insert into [data dictionary] ([table], [field], [index]) select "
        SQL = SQL & "'" & FN & "','" & Data(i) & "','" & i & "'"
        db.Execute SQL
        Next i
Skip: Next F

End Function

Function TestFile(ByVal path As String)
   Dim buffer As String
   Dim InFileNum As Integer
   Dim firstByte As Integer
   Dim secondByte As Integer
   Dim thirdByte As Integer

   buffer = String(100, " ")

   InFileNum = FreeFile

   Open path For Binary Access Read As InFileNum

   Get InFileNum, , buffer

   Close InFileNum

   firstByte = Asc(Mid(buffer, 1, 1))
   secondByte = Asc(Mid(buffer, 2, 1))
   thirdByte = Asc(Mid(buffer, 3, 1))

   If (firstByte = 255 And secondByte = 254) Then
       TestFile = "Unicode"
   ElseIf (firstByte = 254 And secondByte = 255) Then
       TestFile = "Unicode"
   ElseIf (firstByte = 239 And secondByte = 187 And thirdByte = 191) Then
       TestFile = "Unicode"
   Else
       TestFile = "ASCII"

   End If

End Function

Function import()

Folder = DLookup("[data folder]", "folder")
Set db = CurrentDb()
Dim FSO As New FileSystemObject

Set Tlist = db.OpenRecordset("select [table] from [data dictionary] where ([required]<>'') group by [table]")
Tlist.MoveFirst
Do While Not Tlist.EOF
    TN = Tlist.Fields("table").Value
    Delete_table (TN)
    Set flist = db.OpenRecordset("select * from [data dictionary] where [required]<>'' and [table]='" & TN & "'")
    flist.MoveFirst
    Text = ""
    Do While Not flist.EOF
        FN = flist.Fields("Field")
        Text = Text & "," & FN & " " & IIf(InStr(FN, "Date") > 0 Or InStr(FN, "_DT") > 0, "DATETIME", "TEXT")
        flist.MoveNext
        Loop
    SQL = "CREATE TABLE " & TN & "(" & Mid(Text, 2) & ")"
    db.Execute SQL

    path = Folder & "\" & TN & ".csv"
    If TestFile(path) = "ASCII" Then
        Set instream = FSO.OpenTextFile(path, ForReading, , 0)
        Else: Set instream = FSO.OpenTextFile(path, ForReading, , -1)
        End If

    header = instream.ReadLine
    Do While Not instream.AtEndOfStream
        Line = parser(instream.ReadLine)
        Data = Split(Line, ",")
        flist.MoveFirst
        Text = ""
        Do While Not flist.EOF
            n = flist.Fields("index").Value
            Text = Text & ",'" & Data(n) & "'"
            flist.MoveNext
            Loop
        SQL = "insert into [" & TN & "] values(" & Mid(Text, 2) & ")"
        db.Execute SQL
        Loop

    Tlist.MoveNext
    Loop
x = MultipleCodes()
MsgBox ("done")
End Function

Function parser(S)
parser = S
i = InStr(S, Chr(34))
If i = 0 Then
    parser = S
    Else
        j = InStr(i + 1, S, Chr(34))
        T = Mid(S, i + 1, j - i - 1)
        T = Replace(T, ",", ";")
        parser = Left(S, i - 1) & T & parser(Mid(S, j + 1))
    End If
End Function

导入CSV并强制所有字段为文本格式

1 个答案: