TransferText

**Trevor Best** · Nov 13 '05, 01:14 PM

Re: TransferText

axelleforever wrote:[color=blue]
> 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.TransferT ext 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.
>[/color]

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 = "tblImportWizTe mp"
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 acSysCmdInitMet er, "Parsing file", LOF(hFileIn)
' loop and get all the fields into text
Do Until EOF(hFileIn)
Line Input #hFileIn, strText
SysCmd acSysCmdUpdateM eter, Loc(hFileIn) * 128
Select Case True
Case Len(Trim(strTex t)) = 0
' ignore line
Case Left(strText, Len(pstrComment char)) = pstrCommentchar
And Len(pstrComment char) > 0
' ignore line
Case Else
' split the fields into an array
strColumn = SplitFields(str Text, pstrDelim, pstrQuote)
' now re-create the CSV line making it all text fields
strText = cstrQuote & strColumn(0) & cstrQuote
For i = 1 To UBound(strColum n)
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 acSysCmdRemoveM eter

'Debug.Print "Parsing text file: "; lngRow & " row(s): " &
DateDiff("s", varStart, Now()) & " seconds"

' re-link the table.
DoCmd.TransferT ext acLinkDelim, , cstrTempTable, strTempFile,
pfHasFieldNames

ParseFileToTemp _Exit:
On Error Resume Next
SysCmd acSysCmdRemoveM eter
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, "ParseFileToTem p", 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.Table Defs.Delete pstrTable
End Function

Private Function SplitFields(pst rtext 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,107 6,,,725,,5,1518 0,,,,,,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(strEle ment, 1) =
""""))
Do While Right(strElemen t, 1) = """"
strElement = Left(strElement , Len(strElement) - 1)
Loop
strReturnArray( lngElements) = strElement
End If
Loop

SplitFields = Split(Join(strR eturnArray(), "~~~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

**axelleforever** · Nov 13 '05, 01:14 PM

Re: TransferText

Je ne suis pas très partisans du code à outrance. Qu'est-ce que ce
fichier schema.ini ? J'ai 125 fichiers textes à importer dans 125
tables. Je peux à la rigueur créer un fichier schema.ini mais quel
est son format ? Mon poste de travail ne recense aucun schema.ini
malgré plusieurs sauvegardes de format d'importation !

**Trevor Best** · Nov 13 '05, 01:16 PM

Re: TransferText

axelleforever wrote:[color=blue]
> Je ne suis pas très partisans du code à outrance. Qu'est-ce que ce
> fichier schema.ini ? J'ai 125 fichiers textes à importer dans 125
> tables. Je peux à la rigueur créer un fichier schema.ini mais quel
> est son format ? Mon poste de travail ne recense aucun schema.ini
> malgré plusieurs sauvegardes de format d'importation !
>[/color]

Je ne sais d'aucun fichier de schema.ini.

De ma position je vois 2 choix :

1. Employez le code pour convertir le dossier en format que l'Access
importera facilement ou...

2. Créez 125 caractéristique s d'importation.

--
[OO=00=OO]

**Trevor Best** · Nov 13 '05, 01:17 PM

Re: TransferText

Trevor Best wrote:[color=blue]
> 1. Employez le code pour convertir le dossier en format que l'Access
> importera facilement ou...[/color]

apologies, dossier = fichier (stupid Lycos :-)

--
[OO=00=OO]