2017-07-24 171 views
0

我正在將一系列CSV文件導入到Access表中。我有以下行輸入每個文件:導入CSV並強制所有字段爲文本格式

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

此導入語句工作並創建必要的表。但是,它會根據數據創建字段類型,並且根據數據的前幾行可能會創建一個數字字段(應該是文本),然後在稍後在文件中遇到文本值時會導致錯誤。

如何強制輸入文件中的每個字段的字段類型爲文本?我之前使用過導入規格,但首先文件格式(由我的控制以外的人提供)可能會不時變化,其次是200列以上的非常「寬」的文件,所以這不是一個實際的答案。

回答

0

這不是一個很好的解決方法,但我必須經過這個過程來解決表格中的255字段限制。總之,我結束了導入步驟,是

  1. 讀取文件的第一行作爲一個InputStream
  2. 分割線來獲得字段名,把它們放在一個數據字典表,然後手動標記那些我想要導入
  3. 使用CREATE TABLE來創建一個新的數據表(只選定字段)與所有設置爲TEXT
  4. 領域的讀取文件中的每一行作爲一個InputStream
  5. 斯普利特線獲取每個字段的數據
  6. 使用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 
相關問題