Import and add File Name to field

[Craig]

I have to import mutliple files to clean and update and export them back out
again. The files do not have a reference as to where the data comes from.

I use a function to import all the data at once into one table but want to
add the filename to the end of each record so i can determin where each
record originated from.

Any ideas if this is possilbe and how to achieve this.

Thanks
Craig

Private Sub cmdImport_Click()
Dim strfile As String
Dim path As String

path = "C:\Documents and Settings\Lists\"
ChDir ("C:\Documents and Settings\Lists\")
strfile = Dir("*.txt")
Do While Len(strfile) > 0
DoCmd.TransferText acImportDelim, "multiimport", "Import", path & strfile,
True
strfile = Dir
Loop
End If
End Sub

 

[strive4peace]

code: AddFieldToTable
---

Hi Craig,

Option Compare Database
Option Explicit

'~~~~~~~~~~~~~~~~
'example showing how to add certain fields to a particular table
'~~~~~~~~~~~~~~~~

Sub testaddFieldToTable()
AddFieldToTable "test", "AutoID", dbLong, , "*AN*"
AddFieldToTable "test", "SomeID", dbLong, , "*Null*"
AddFieldToTable "test", "ImportLog", dbText, 255
AddFieldToTable "test", "DateCreated", dbDate, , "*Now*"

End Sub

'~~~~~~~~~~~~~~~~
'example showing how to add the same fields
'to every user table in the database
'~~~~~~~~~~~~~~~~

Sub AddDateUserToTables()
Dim tdf As dao.TableDef, i As Integer
i = 1
For Each tdf In CurrentDb.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then

AddFieldToTable tdf.Name, _
"UserIDc", dbLong, , "*Null*"

AddFieldToTable tdf.Name, _
"UserIDm", dbLong, , "*Null*"

AddFieldToTable tdf.Name, _
"DateCreated", dbDate, , "*Now*"

AddFieldToTable tdf.Name, _
"DateModified", dbDate

i = i + 1
End If
Next tdf
DoEvents
Set tdf = Nothing
MsgBox "Added fields to " & i & " tables", , "Done"
End Sub

'~~~~~~~~~~~~~~~~

put the following function in a general module:
'~~~~~~~~~~~~~~~~

Function AddFieldToTable( _
pTablename As String, _
pFldname As String, _
pDataType As Integer, _
Optional pFieldSize As Integer, _
Optional pDefaultValue As String) _
As Boolean

'written by Crystal
'strive4peace2007 at yahoo.com

'PARAMETERS
'pTablename --> name of table to modify structure of
'pFldname --> name of field to create
'pDataType --> dbText, dbLong, dbDate, etc
'pFieldSize --> length for text fields
'pDefaultValue --> *AN* = autonumber
' --> *Null* --> DefaultValue = Null
' --> *Now* --> DefaultValue = Now()
' --> otherwise whatever is specified

'NEEDS Reference to
'a Microsoft DAO Library

On Error GoTo Proc_Err

Dim db As Database, Fld As Field

'you could make this a passed parameter
' and open another database

Set db = CurrentDb

With db.TableDefs(pTablename)

Select Case pDataType
Case dbText
'Text
Set Fld = .CreateField(pFldname, _
pDataType, pFieldSize)

Case Else
'Long Integer, Date, etc
Set Fld = .CreateField(pFldname, pDataType)

End Select

If Len(Nz(pDefaultValue, "")) > 0 Then
Select Case pDefaultValue
Case "*AN*"
'Autonumber
Fld.Attributes = dbAutoIncrField
Case "*Null*"
'Null for DefaultValue
Fld.DefaultValue = "Null"
Case "*Now*"
'Now for DefaultValue
Fld.DefaultValue = "=Now()"
Case Else
'Now for DefaultValue
Fld.DefaultValue = "=" & pDefaultValue
End Select
End If

If pDataType = dbText Then
Fld.AllowZeroLength = True
End If

.Fields.Append Fld
End With

db.TableDefs.Refresh
DoEvents

' MsgBox "Added --> " & pFldname _
& " to --> " & pTablename, , "Done"

AddFieldToTable_exit:
On Error Resume Next
Set Fld = Nothing
Set db = Nothing

Exit Function

Proc_Err:
'if the field is already there, ignore error
If Err = 3191 Then Resume Next

MsgBox Err.Description, , _
"ERROR " & Err.Number & " AddFieldToTable"

'press F8 to step through code and fix problem
'comment next line after debugged
Stop: Resume

Resume AddFieldToTable_exit

End Function
'~~~~~~~~~~~~~~~~


Warm Regards,
Crystal
*
have an awesome day
*
MVP Access
Remote Programming and Training
strive4peace2006 at yahoo.com
*