TransferText still creating an import error

[ECEK]

I have the following in my code

DoCmd.TransferText acImportDelim, AdviserImportSpecification, tblName, InputDir & ImportFile, True

However one of the fileds in my csv file is a mix of text and numbers.
My destination table is formatted to ShortText but it is still erroring on the numbers.

How can I import the numbers to the ShortText field without the error.

It would appear that if the first entry is a number then it will import and reject any text and vice versa.

The specification just isn't working !!

Your advice is much appreciated.

 

[Gasman]

Why are you starting a new thread :banghead:

 

[ECEK]

Because I need a solution to this and my initial thread may detract people who can help

 

[arnelgp]

here is yet another vba for your import
requirement. i think it just import and don't
care if your csv column is mixed type.
run it on each file you want to import.

to run (sample):

subVBAImport "AccessTableToPutImport", "D:\folder\Book1.csv"
subVBAImport "AccessTableToPutImport", "D:\folder\Book2.csv"
subVBAImport "AccessTableToPutImport", "D:\folder\Book3.csv"

Public Sub subVBAImport(ByVal TargetTable As String, ByVal Filename As String)
' import text file
    Dim db As DAO.Database
    Dim rs As DAO.recordSet
    Dim fld As DAO.Field
    Dim arrSourceFields() As String
    Dim arrTargetFields() As String
    Set db = CurrentDb
    Set rs = db.OpenRecordset(TargetTable, dbOpenSnapshot)
    ReDim arrSourceFields(0)
    ReDim arrTargetFields(0)
    ' put field name to array
    For Each fld In rs.Fields
        If Not IsAutoNumber(fld) Then
            ReDim Preserve arrTargetFields(UBound(arrTargetFields) + 1)
            arrTargetFields(UBound(arrTargetFields)) = fld.Name
        End If
    Next
    rs.Close
    Set rs = Nothing
    Set rs = db.OpenRecordset("Select * From [Text;HDR=Yes;IMEX=2;ACCDB=YES;DATABASE=" & _
            fnFilePart(Filename, "Path") & "].[" & _
            fnFilenameWithoutExtension(Filename) & "#" & _
            fnFilePart(Filename, "Extension") & "];")
    ' put field name to array
    For Each fld In rs.Fields
        ReDim Preserve arrSourceFields(UBound(arrSourceFields) + 1)
        arrSourceFields(UBound(arrSourceFields)) = fld.Name
    Next
    rs.Close
    Set rs = Nothing
    ' build insert query
    ' include only fields common to both tables
    Dim strSQL1 As String
    Dim strSQL2 As String
    strSQL1 = "Insert Into " & TargetTable & " ("
    strSQL2 = "Select "
    For i = 1 To UBound(arrTargetFields)
        If InArray(arrTargetFields(i), arrSourceFields) Then
            strSQL1 = strSQL1 & "[" & arrTargetFields(i) & "]" & ","
            strSQL2 = strSQL2 & "[" & arrTargetFields(i) & "]" & ","
        End If
    Next
    strSQL1 = Left(strSQL1, Len(strSQL1) - 1) & ") "
    strSQL2 = Left(strSQL2, Len(strSQL2) - 1) & _
        " From [Text;HDR=Yes;IMEX=2;ACCDB=YES;DATABASE=" & _
            fnFilePart(Filename, "Path") & "].[" & _
            fnFilenameWithoutExtension(Filename) & "#" & _
            fnFilePart(Filename, "Extension") & "];"
            
    strSQL1 = strSQL1 & strSQL2
    db.Execute strSQL1, dbFailOnError
    Set db = Nothing
End Sub

''''''''''''''
' the rest are helper functions
'
'
Public Function fnFilePart(ByVal Filename As String, ReturnPart As String) As String
'
' valid returnPart  =   "Path", "Filename", "Extension"
    Dim var As Variant
    Dim strReturn As String
    Dim i As Integer
    Filename = Trim(Filename)
    var = Split(Filename, "\")
    Select Case ReturnPart
        Case Is = "Path"
            If Trim(var(0)) = Filename Then
                If InStr(var(0), "\") = 0 Then
                    strReturn = Filename
                End If
            Else
                For i = 0 To UBound(var) - 1
                    strReturn = strReturn & var(i) & "\"
                Next
            End If
                
        Case Is = "Filename"
            If Trim(var(UBound(var))) = Filename Then
                strReturn = Filename
            Else
                strReturn = var(UBound(var))
            End If
        Case Is = "Extension"
            strReturn = Mid(var(UBound(var)), InStrRev(var(UBound(var)), ".") + 1)
        Case Else
            MsgBox "Wrong argument"
    End Select
    fnFilePart = strReturn
End Function

Public Function fnFilenameWithoutExtension(ByVal Filename As String) As String
    Dim strReturn As String
    strReturn = fnFilePart(Filename, "Filename")
    fnFilenameWithoutExtension = Left(strReturn, Len(strReturn) - Len(fnFilePart(Filename, "Extension")) - 1)
End Function

Public Function InArray(ByVal Element As Variant, ByRef Arry As Variant) As Boolean
    Dim i As Integer
    For i = 0 To UBound(Arry)
        If Arry(i) = Element Then
            InArray = True
            Exit For
        End If
    Next
End Function

Function IsAutoNumber(ByRef fld As DAO.Field) As Boolean
On Error GoTo ErrHandler

  IsAutoNumber = (fld.Attributes And dbAutoIncrField)

ExitHere:
  Exit Function
ErrHandler:
  Debug.Print err, err.description
  Resume ExitHere
End Function