axelleforever wrote:
Bonjour,
La première colonne de mon fichier texte (séparateur points-virgules)
contient des valeurs alphanumériques (1,2a,3u etc). Je constate que
seules les valeurs numériques sont importées dans la première
colonne de ma table "MaTable".
Expression vba utilisée : DoCmd.TransferText acImportDelim, ,
"MaTable", "C:\fichier.txt", True
NE ME PARLER PAS DE FORMAT D'IMPORTATION car j'ai 125 fichiers à plat
et tous différents ; je ne peux donc me permettre de créer (via
l'assistant d'importation) 125 formats d'importation !
Est-ce à dire qu'Access suppose par défaut que la première colonne
d'une fichier texte est numérique sans spécification de format
d'importation ?
J'ai lu des messages à ce propos mais aucun n'a répondu clairement.
Merci pour votre aide.
The code below my sig may help. It converts any variable length ASCII
file to a CSV file with quotes (") around all fields to make Access
think everything is text. Watch out for wrapping, people don't like
attachments in this group, even text ones. And don't copy the BMW grill,
it won't compile :-)
Translation by Lycos / Traduction par Lycos
Le code au-dessous de mes sig peut aider. Il convertit n'importe quel
fichier ASCII de longueur variable en dossier de CSV avec des citations
(") autour de tous les champs pour faire l'Access penser tout est texte.
Observez dehors pour s'envelopper, les gens n'aiment pas des
attachements dans ce groupe, même texte ceux. Et ne copiez pas le gril
de BMW, il ne compilera pas :-)
--
[OO=00=OO]
Option Compare Database
Option Explicit
Public Function ParseFileToTemp(pstrFile As String, pstrDelim As String,
pstrQuote As String, pfHasFieldNames As Boolean, Optional plngRows As
Long = 0, Optional pstrCommentchar As String = "")
' Error Trapped: 06/10/2004 16:41:21 sa
On Error GoTo ParseFileToTemp_Err
' TB: Takes a variable length delimited file and creates a CSV file
with it then
' links it as a table, even CSV files are put through this as we
basically make
' every column into text in the resultant CSV file there can be no
mistake in
' the way Access interprets the data, e.g. it can make assumptions
that a field
' is numeric then barf when it encounters text in it. Also foreign
formatted dates
' will come through as text and be handled by another procedure.
Dim hFileIn As Integer
Dim hFileOut As Integer
Dim strTempFile As String
Dim strText As String
Dim strColumn() As String
Dim i As Integer
Dim lngRow As Long
Dim varStart As Variant
Const cstrTempTable As String = "tblImportWizTemp"
Const cstrQuote As String = """"
varStart = Now()
' drop the linked CSV file table
DropImportTable cstrTempTable
' open our input and output files
hFileIn = FreeFile
Open pstrFile For Input As #hFileIn
hFileOut = FreeFile
strTempFile = Environ("TEMP") & "\MA_Import.CSV"
Open strTempFile For Output As #hFileOut
SysCmd acSysCmdInitMeter, "Parsing file", LOF(hFileIn)
' loop and get all the fields into text
Do Until EOF(hFileIn)
Line Input #hFileIn, strText
SysCmd acSysCmdUpdateMeter, Loc(hFileIn) * 128
Select Case True
Case Len(Trim(strText)) = 0
' ignore line
Case Left(strText, Len(pstrCommentchar)) = pstrCommentchar
And Len(pstrCommentchar) > 0
' ignore line
Case Else
' split the fields into an array
strColumn = SplitFields(strText, pstrDelim, pstrQuote)
' now re-create the CSV line making it all text fields
strText = cstrQuote & strColumn(0) & cstrQuote
For i = 1 To UBound(strColumn)
strText = strText & "," & cstrQuote & strColumn(i)
& cstrQuote
Next
Print #hFileOut, strText
' check if sample data wanted
lngRow = lngRow + 1
If lngRow >= plngRows And plngRows > 0 Then
Exit Do
End If
End Select
Loop
' close files
Close #hFileIn
Close #hFileOut
SysCmd acSysCmdRemoveMeter
'Debug.Print "Parsing text file: "; lngRow & " row(s): " &
DateDiff("s", varStart, Now()) & " seconds"
' re-link the table.
DoCmd.TransferText acLinkDelim, , cstrTempTable, strTempFile,
pfHasFieldNames
ParseFileToTemp_Exit:
On Error Resume Next
SysCmd acSysCmdRemoveMeter
DoCmd.Hourglass False
Exit Function
ParseFileToTemp_Err:
Select Case Err
Case Else
'LogMsgBox Err, Err.Description, 16, "Error #" & Err & " In
ParseFileToTemp()"
' bubble up, we want the calling procedure to handle the error
Err.Raise Err.number, "ParseFileToTemp", Err.Description
End Select
Resume ParseFileToTemp_Exit
End Function
Function DropImportTable(pstrTable As String)
' TB: Bet you cannie work out what this does :-)
' actually uses DAO rather than SQL Drop as at time of writing SQL
Drop didn't work, table still there :-(
On Error Resume Next
CurrentDb.TableDefs.Delete pstrTable
End Function
Private Function SplitFields(pstrtext As String, pstrDelim As String,
pstrQuote As String) As String()
' TB
' Usual Split() function won't work for our strings as the
delimiter may be
' just a comma or may be a comma with quotes or combination
' e.g.
' 37740,"DRG-003-C",1,"0","a description, with a comma in
it",2/12/2003 00:00:00,16,1076,,,725,,5,15180,,,,,,0
Dim strReturnArray() As String
Dim strTemp As String
Dim strElement As String
Dim lngElements As Long
Dim strDelim As String
strTemp = pstrtext
Do While Len(strTemp)
If Len(pstrQuote) Then
strDelim = String(Abs(Left(strTemp, 1) = pstrQuote),
pstrQuote) & pstrDelim
Else
strDelim = pstrDelim
End If
strElement = GetFirstElement(strTemp, strDelim)
If Len(strTemp) Then
strTemp = Mid(strTemp, Len(strElement) + Len(strDelim) + 1)
'Debug.Print strTemp
lngElements = lngElements + 1
ReDim Preserve strReturnArray(1 To lngElements)
' Strip off first " if existing
strElement = Mid(strElement, 1 + Abs(Left(strElement, 1) =
""""))
Do While Right(strElement, 1) = """"
strElement = Left(strElement, Len(strElement) - 1)
Loop
strReturnArray(lngElements) = strElement
End If
Loop
SplitFields = Split(Join(strReturnArray(), "~~~moo!~~~"), "~~~moo!~~~")
End Function
Private Function GetFirstElement(sStr As String, strDelimiter As String)
As String
On Error GoTo Err_GetElement
' TB: Nicked from Jezzer's GetElement :-)
Dim nX As Integer
Dim nY As Integer
Dim nC As Integer
' Want first element which is a special case.
nX = InStr(1, sStr, strDelimiter, vbTextCompare)
If nX = 0 Then
' There is no 'strDelimiter' in the string, therefore return
the whole string.
GetFirstElement = sStr
Else
GetFirstElement = Mid(sStr, 1, nX - 1)
End If
Exit_GetElement:
Exit Function
Err_GetElement:
Select Case Err.number
Case 5 ' Invalid procedure call.
' Caused by a series of empty keys passed and a call to
'mid' can not be carried out as a position is negative.
' Return the empty string
GetFirstElement = ""
Resume Exit_GetElement
Case Else
' Unexpected error - return empty string.
GetFirstElement = ""
Resume Exit_GetElement
End Select
End Function
