Hair is coming out (VBA HELP) (1 Viewer)

mike.molina

Registered User.
Local time
Yesterday, 23:34
Joined
Jul 2, 2014
Messages
12
[SOLVED] Hair is coming out (VBA HELP)

Hello All,

I have a database in which I am importing data from .csv to an Access table. I keep getting a run-time error of 2391 which reads "Field XXX doesn't exist in destination table 'Subinv'" The "XXX" is where the error display some weird characters. Below is the code I am using to import the CSV into the existing Access table:

Code:
 '===============IMPORT GROUP DATA=====================
 Private Sub Command35_Click()
Dim filepath As String
 filepath = "C:\UUAM\Subinv.csv"
If FileExist2(filepath) Then
DoCmd.TransferText acImportDelim, , "Subinv", filepath, True

Else
  MsgBox "File not found. Please check file name, file extension or file location."
End If
End Sub
 Function FileExist2(sTestFile As String) As Boolean
 Dim lsize As Long
On Error Resume Next
lsize = -1
lsize = FileLen(sTestFile)
If lsize > -1 Then
FileExist2 = True
Else
FileExist2 = False
End If
MsgBox ("Subinv Data upload successfully")
End Function
PLEASE HELP:confused::confused::confused:
 
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 17:34
Joined
May 7, 2009
Messages
19,175
as the message suggest, you don't have that field in your table.
the best way to do this is get all the fieldname from your table and import only those fields that exists.

this method is long (not tested).
im sure there are people there who has better solution
Code:
Private Sub Command35_Click()
    const filepath As String = "C:\UUAM\"
    Const filename as string = "Subinv"
    Const fileExt as string = "csv"
    If FileExists2(filepath) then
        Call subImport ("SubInv", Filepath, filename, fileext)
    Else
        Msgbox "File not found. Please check filename, file extension or file location."
    End If
End Sub

Function FileExist2(sTestFile As String) As Boolean
    Dim lsize As Long
    On Error Resume Next
    lsize = -1
    lsize = FileLen(sTestFile)
    If lsize > -1 Then
        FileExist2 = True
    Else
        FileExist2 = False
    End If
    MsgBox ("Subinv Data upload successfully")
End Function

Private Sub subImport(strTargetTable As String, Filepath as string, Filename as string, Fileext As String)
    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(strTargetTable, 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(arrTargetFfields))
            arrTargetFields(Ubound(arrTargetFields)) = fld.Name
        End If
    Next
    Set rs = Nothing
    Set rs = db.OpenRecordset("Select * From [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
            Filepath & "].[" & Filename & "#" & Fileext & ";")
    ' put field name to array
    For each fld In rs.Fields
        Redim Preserve arrSourceFields(UBound(arrSourceFields))
        arrSourceFields(Ubound(arrSourceFields)) = fld.Name
    next
    Set rs = nothing
    ' build insert query
    ' include only fields common to both tables
    Dim strSQL1 As String
    Dim strSQL2 As String
    strSQL1 = "Insert Into " & strTargetTable & " ("
    strSQL2 = "Select " 
    For i = 1 to UBound(arrTargetFields)
        If Not 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 [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
            Filepath & "].[" & Filename & "#" & Fileext & ";"
    strSQL1 = strSQL1 & strSQL2
    db.Execute strSQL1, dbFailOnError
    set db=nothing
End Sub

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

Private Function InArray(s As String, v As Variant) As Boolean
Dim i As Long
For i = LBound(v) To UBound(v)
    If s = v(i) & "" Then
        InArray = True
        Exit For
    End If
Next
End Function
 

mike.molina

Registered User.
Local time
Yesterday, 23:34
Joined
Jul 2, 2014
Messages
12
arnelgp,

Thank you for responding. I copied and pasted the info you provided; however, received an immediate error. "File not found. Please check fieldname, file extension or file location." I double checked the raw data and table and both are labeled correctly.

R/s,
Mike
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 17:34
Joined
May 7, 2009
Messages
19,175
edit this part:

Code:
    Set rs = db.OpenRecordset("Select * From [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
            Filepath & "].[" & Filename & "#" & Fileext & ";")
to:

Code:
    Set rs = db.OpenRecordset("Select * From [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
            Filepath & "].[" & Filename & "#" & Fileext & "[COLOR=Blue]][/COLOR];")


also this part:

Code:
   strSQL2 = Left(strSQL2, Len(strSQL2)-1) & _
        "From [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
            Filepath & "].[" & Filename & "#" & Fileext & ";"


To:


Code:
   strSQL2 = Left(strSQL2, Len(strSQL2)-1) & _
        "From [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
            Filepath & "].[" & Filename & "#" & Fileext & "[COLOR=Blue]][/COLOR];"
 

mike.molina

Registered User.
Local time
Yesterday, 23:34
Joined
Jul 2, 2014
Messages
12
this is what the code looks like right now:



Private Sub Command36_Click()
Const Filepath As String = "C:\UUAM\"
Const Filename As String = "Subinv"
Const Fileext As String = "csv"
If FileExist3(Filepath) Then
Call subImport("SubInv", Filepath, Filename, Fileext)
Else
MsgBox "File not found. Please check filename, file extension or file location."
End If
End Sub
Function FileExist3(sTestFile As String) As Boolean
Dim lsize As Long
On Error Resume Next
lsize = -1
lsize = FileLen(sTestFile)
If lsize > -1 Then
FileExist3 = True
Else
FileExist3 = False
End If
MsgBox ("Subinv Data upload successfully")
End Function
Private Sub subImport(strTargetTable As String, Filepath As String, Filename As String, Fileext As String)
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(strTargetTable, 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(arrTargetFfields))
arrTargetFields(UBound(arrTargetFields)) = fld.Name
End If
Next
Set rs = Nothing
Set rs = db.OpenRecordset("Select * From [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
Filepath & "].[" & Filename & "#" & Fileext & "];")
' put field name to array
For Each fld In rs.Fields
ReDim Preserve arrSourceFields(UBound(arrSourceFields))
arrSourceFields(UBound(arrSourceFields)) = fld.Name
Next
Set rs = Nothing
' build insert query
' include only fields common to both tables
Dim strSQL1 As String
Dim strSQL2 As String
strSQL1 = "Insert Into " & strTargetTable & " ("
strSQL2 = "Select "
For i = 1 To UBound(arrTargetFields)
If Not 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 [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
Filepath & "].[" & Filename & "#" & Fileext & "];"
strSQL1 = strSQL1 & strSQL2
db.Execute strSQL1, dbFailOnError
Set db = Nothing
End Sub
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
Private Function InArray(s As String, v As Variant) As Boolean
Dim i As Long
For i = LBound(v) To UBound(v)
If s = v(i) & "" Then
InArray = True
Exit For
End If
Next
End Function
 

Anakardian

Registered User.
Local time
Today, 10:34
Joined
Mar 14, 2010
Messages
173
one way to get around a field not existing in the tbale is to use the normal import function in access to import the csv file once.
Let it create a new table for you. this ensures it names the fields in the correct manner.

Delete the contents of the table and you have a template for the import table you can use to work on.

One thing I have found is that access takes a dim view of any "." in a field name. these can easily exist in excel and probably also other applications so be vary of those.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 17:34
Joined
May 7, 2009
Messages
19,175
that was untested, as ive said.
i can't help but test it on my own db.
this one will do it for you.
copy and paste all codes replacing your old ones.
Code:
Private Sub Command35_Click()
    Const Filepath As String = "z:\"
    Const Filename As String = "holiday"
    Const Fileext As String = "csv"
    If FileExist2(Filepath & Filename & "." & Fileext) Then
        Call subImport("tblholiday", Filepath, Filename, Fileext)
    Else
        MsgBox "File not found. Please check filename, file extension or file location."
    End If
End Sub

Private Function FileExist2(sTestFile As String) As Boolean
    Dim lsize As Long
    On Error Resume Next
    lsize = -1
    lsize = FileLen(sTestFile)
    If lsize > -1 Then
        FileExist2 = True
    Else
        FileExist2 = False
    End If
    MsgBox ("Subinv Data upload successfully")
End Function

Private Sub subImport(strTargetTable As String, Filepath As String, Filename As String, Fileext As String)
    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(strTargetTable, 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
    Set rs = Nothing
    Set rs = db.OpenRecordset("Select * From [Text;HDR=Yes;IMEX=2;ACCDB=YES;DATABASE=" & _
            Filepath & "].[" & Filename & "#" & Fileext & "];")
    ' put field name to array
    For Each fld In rs.Fields
        ReDim Preserve arrSourceFields(UBound(arrSourceFields) + 1)
        arrSourceFields(UBound(arrSourceFields)) = fld.Name
    Next
    Set rs = Nothing
    ' build insert query
    ' include only fields common to both tables
    Dim strSQL1 As String
    Dim strSQL2 As String
    strSQL1 = "Insert Into " & strTargetTable & " ("
    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=" & _
            Filepath & "].[" & Filename & "#" & Fileext & "];"
    strSQL1 = strSQL1 & strSQL2
    db.Execute strSQL1, dbFailOnError
    Set db = Nothing
End Sub


Private Function InArray(s As String, v As Variant) As Boolean
Dim i As Long
For i = LBound(v) To UBound(v)
    If s = v(i) & "" Then
        InArray = True
        Exit For
    End If
Next
End Function

Private 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
 

mike.molina

Registered User.
Local time
Yesterday, 23:34
Joined
Jul 2, 2014
Messages
12
[SOLVED] Hair is coming out (VBA HELP)

[SOLVED]

Thanks for all of the input you guys provided...although they were good recommendations, I found the only thing I needed to do was add a specification name within my code due to the fact that the file is a CSV. Apparently, this is a known Microsoft issue when importing text. Even though when researching the topic Microsoft says the specification name is optional, my code would only work if I included it.

Instead of:

DoCmd.TransferText acImportDelim, , "Subinv", filepath, True

needed to read:

DoCmd.TransferText acImportDelim, "Subinv Import Specification", "SubInv", "C:\UUAM\Subinv.csv", True


thanks guys:):)
 
Last edited:

Users who are viewing this thread

Top Bottom