SOLVED: Import to access via VBA

[mvidas]

Hi everyone,

I am a complete newbie when it comes to using VBA in access (newbie in access too). I got the following sub from someone else, and modified it to suit my needs, and while this isn't giving me any errors it's not updating my table either. The only field not referenced in the sub is the "ID" field, which has an AutoNumber, so I figured I didn't need to reference that in here at all.

quick background: HUGE text files (1 mil-2.5 mil lines, 75 fields), I will be running this each month to 3-6 different text files each with different names and different locations. I wanted something to be able to append to existing tables or create a new table, and was suggested the code below. As I said I modified it to include all the fields I need/etc, and after adding the DAO 3.6 reference I was able to run it without errors. But I don't see any changes made to my table after looping through this a few times.

Any idea what I'm doing wrong?

[vba]
Public Function ReadFile()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strRecordSource As String 'Source for recordset, can be SQL, table, or saved query
Dim intFileDesc As Integer 'File descriptor for source file
Dim strSourceFile As String 'Full path of source file
Dim vIn As String 'Input buffer
Dim strField75 As String

' Name of your file and table.
strSourceFile = "c:\subinf\ca.txt"
strRecordSource = "az"
Set dbs = CurrentDb

Set rst = dbs.OpenRecordset(strRecordSource, dbOpenDynaset)
intFileDesc = FreeFile
Open strSourceFile For Input As #intFileDesc
Do While Not EOF(intFileDesc)
Line Input #intFileDesc, vIn

' Add record in rst and fill fields:
rst.AddNew
rst.Fields("SUBSTS") = Mid(vIn, 1, 1)
rst.Fields("SUBCO#") = Mid(vIn, 2, 3)
rst.Fields("SUBEXC") = Mid(vIn, 5, 7)
rst.Fields("SUBLN#") = Mid(vIn, 12, 5)
rst.Fields("SUBRES") = Mid(vIn, 17, 2)
rst.Fields("SUBLSN") = Mid(vIn, 19, 15)
rst.Fields("SUBFRN") = Mid(vIn, 34, 15)
rst.Fields("SUBAD1") = Mid(vIn, 49, 30)
rst.Fields("SUBAD2") = Mid(vIn, 79, 30)
rst.Fields("SUBAD3") = Mid(vIn, 109, 30)
rst.Fields("SUBCTY") = Mid(vIn, 139, 20)
rst.Fields("SUBSAB") = Mid(vIn, 159, 2)
rst.Fields("SUBZCD") = Mid(vIn, 161, 10)
rst.Fields("SUBFTX") = Mid(vIn, 171, 1)
rst.Fields("SUBSTX") = Mid(vIn, 172, 2)
rst.Fields("SUBBLK") = Mid(vIn, 174, 3)
rst.Fields("SUBSTP") = Mid(vIn, 177, 2)
rst.Fields("SUBBMT") = Mid(vIn, 179, 1)
rst.Fields("SUBCRT") = Mid(vIn, 180, 1)
rst.Fields("SUBLCR") = Mid(vIn, 181, 1)
rst.Fields("SUBSNI") = Mid(vIn, 182, 3)
rst.Fields("SUBDNP") = Mid(vIn, 185, 3)
rst.Fields("SUBRCN") = Mid(vIn, 188, 3)
rst.Fields("SUBLTD") = Mid(vIn, 191, 9)
rst.Fields("SUBPSN") = Mid(vIn, 200, 3)
rst.Fields("SUBPRC") = Mid(vIn, 203, 3)
rst.Fields("SUBPDC") = Mid(vIn, 206, 3)
rst.Fields("SUBTLM") = Mid(vIn, 209, 1)
rst.Fields("SUBSCD") = Mid(vIn, 210, 3)
rst.Fields("SUBCCD") = Mid(vIn, 213, 3)
rst.Fields("SUBCDT") = Mid(vIn, 216, 9)
rst.Fields("SUBDDT") = Mid(vIn, 225, 9)
rst.Fields("SUBQBL") = Mid(vIn, 234, 3)
rst.Fields("SUBDTB") = Mid(vIn, 237, 1)
rst.Fields("SUBDLQ") = Mid(vIn, 238, 3)
rst.Fields("SUBBK#") = Mid(vIn, 241, 11)
rst.Fields("SUBTDS") = Mid(vIn, 252, 2)
rst.Fields("SUBBAC") = Mid(vIn, 254, 11)
rst.Fields("SUBHCD") = Mid(vIn, 265, 1)
rst.Fields("SUBAC#") = Mid(vIn, 266, 11)
rst.Fields("SUBLBD") = Mid(vIn, 277, 9)
rst.Fields("SUBLBM") = Mid(vIn, 286, 1)
rst.Fields("SUBLBC") = Mid(vIn, 287, 3)
rst.Fields("SUBTAD") = Mid(vIn, 290, 11)
rst.Fields("SUBSA#") = Mid(vIn, 301, 8)
rst.Fields("SUBBD#") = Mid(vIn, 309, 3)
rst.Fields("SUBBS#") = Mid(vIn, 312, 5)
rst.Fields("SUBE01") = Mid(vIn, 317, 13)
rst.Fields("SUBE02") = Mid(vIn, 330, 13)
rst.Fields("SUBE03") = Mid(vIn, 343, 13)
rst.Fields("SUBE04") = Mid(vIn, 356, 13)
rst.Fields("SUBE05") = Mid(vIn, 369, 13)
rst.Fields("SUBE06") = Mid(vIn, 382, 13)
rst.Fields("SUBE07") = Mid(vIn, 395, 13)
rst.Fields("SUBE08") = Mid(vIn, 408, 13)
rst.Fields("SUBE09") = Mid(vIn, 421, 13)
rst.Fields("SUBE10") = Mid(vIn, 434, 13)
rst.Fields("SUBSOA") = Mid(vIn, 447, 1)
rst.Fields("SUBLNG") = Mid(vIn, 448, 2)
rst.Fields("SUBNMF") = Mid(vIn, 450, 1)
rst.Update
Loop
Close #intFileDesc
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Function
[/vba]

Thanks!
Matt

[mvidas]

OK, this can be deleted for now. I was running this and nothing was updating. I went into design mode to verify they were all setup as text fields, and when I returned to the datasheet view they were there. I had to update the table, I didn't realize this.

This question could probably be deleted now, but if anyone can think of a better way to do what I'm doing, I'd love to hear it..

[SJ McAbney]

One thing I would suggest is to put that function into a module (or Class module if you have many similar procedures) and make the function's return type a Boolean.

i.e.

[vba]
PublicFunction ReadFile() As Boolean
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strRecordSource AsString'Source for recordset, can be SQL, table, or saved query
Dim intFileDesc AsInteger'File descriptor for source file
Dim strSourceFile AsString'Full path of source file
Dim vIn AsString'Input buffer
Dim strField75 AsString

' Name of your file and table.
strSourceFile = "c:\subinf\ca.txt"
strRecordSource = "az"
Set dbs = CurrentDb

Set rst = dbs.OpenRecordset(strRecordSource, dbOpenDynaset)
intFileDesc = FreeFile
Open strSourceFile ForInputAs #intFileDesc
DoWhileNot EOF(intFileDesc)
Line Input #intFileDesc, vIn

' Add record in rst and fill fields:
rst.AddNew
rst.Fields("SUBSTS") = Mid(vIn, 1, 1)
rst.Fields("SUBCO#") = Mid(vIn, 2, 3)
rst.Fields("SUBEXC") = Mid(vIn, 5, 7)
rst.Fields("SUBLN#") = Mid(vIn, 12, 5)
rst.Fields("SUBRES") = Mid(vIn, 17, 2)
rst.Fields("SUBLSN") = Mid(vIn, 19, 15)
rst.Fields("SUBFRN") = Mid(vIn, 34, 15)
rst.Fields("SUBAD1") = Mid(vIn, 49, 30)
rst.Fields("SUBAD2") = Mid(vIn, 79, 30)
rst.Fields("SUBAD3") = Mid(vIn, 109, 30)
rst.Fields("SUBCTY") = Mid(vIn, 139, 20)
rst.Fields("SUBSAB") = Mid(vIn, 159, 2)
rst.Fields("SUBZCD") = Mid(vIn, 161, 10)
rst.Fields("SUBFTX") = Mid(vIn, 171, 1)
rst.Fields("SUBSTX") = Mid(vIn, 172, 2)
rst.Fields("SUBBLK") = Mid(vIn, 174, 3)
rst.Fields("SUBSTP") = Mid(vIn, 177, 2)
rst.Fields("SUBBMT") = Mid(vIn, 179, 1)
rst.Fields("SUBCRT") = Mid(vIn, 180, 1)
rst.Fields("SUBLCR") = Mid(vIn, 181, 1)
rst.Fields("SUBSNI") = Mid(vIn, 182, 3)
rst.Fields("SUBDNP") = Mid(vIn, 185, 3)
rst.Fields("SUBRCN") = Mid(vIn, 188, 3)
rst.Fields("SUBLTD") = Mid(vIn, 191, 9)
rst.Fields("SUBPSN") = Mid(vIn, 200, 3)
rst.Fields("SUBPRC") = Mid(vIn, 203, 3)
rst.Fields("SUBPDC") = Mid(vIn, 206, 3)
rst.Fields("SUBTLM") = Mid(vIn, 209, 1)
rst.Fields("SUBSCD") = Mid(vIn, 210, 3)
rst.Fields("SUBCCD") = Mid(vIn, 213, 3)
rst.Fields("SUBCDT") = Mid(vIn, 216, 9)
rst.Fields("SUBDDT") = Mid(vIn, 225, 9)
rst.Fields("SUBQBL") = Mid(vIn, 234, 3)
rst.Fields("SUBDTB") = Mid(vIn, 237, 1)
rst.Fields("SUBDLQ") = Mid(vIn, 238, 3)
rst.Fields("SUBBK#") = Mid(vIn, 241, 11)
rst.Fields("SUBTDS") = Mid(vIn, 252, 2)
rst.Fields("SUBBAC") = Mid(vIn, 254, 11)
rst.Fields("SUBHCD") = Mid(vIn, 265, 1)
rst.Fields("SUBAC#") = Mid(vIn, 266, 11)
rst.Fields("SUBLBD") = Mid(vIn, 277, 9)
rst.Fields("SUBLBM") = Mid(vIn, 286, 1)
rst.Fields("SUBLBC") = Mid(vIn, 287, 3)
rst.Fields("SUBTAD") = Mid(vIn, 290, 11)
rst.Fields("SUBSA#") = Mid(vIn, 301, 8)
rst.Fields("SUBBD#") = Mid(vIn, 309, 3)
rst.Fields("SUBBS#") = Mid(vIn, 312, 5)
rst.Fields("SUBE01") = Mid(vIn, 317, 13)
rst.Fields("SUBE02") = Mid(vIn, 330, 13)
rst.Fields("SUBE03") = Mid(vIn, 343, 13)
rst.Fields("SUBE04") = Mid(vIn, 356, 13)
rst.Fields("SUBE05") = Mid(vIn, 369, 13)
rst.Fields("SUBE06") = Mid(vIn, 382, 13)
rst.Fields("SUBE07") = Mid(vIn, 395, 13)
rst.Fields("SUBE08") = Mid(vIn, 408, 13)
rst.Fields("SUBE09") = Mid(vIn, 421, 13)
rst.Fields("SUBE10") = Mid(vIn, 434, 13)
rst.Fields("SUBSOA") = Mid(vIn, 447, 1)
rst.Fields("SUBLNG") = Mid(vIn, 448, 2)
rst.Fields("SUBNMF") = Mid(vIn, 450, 1)
rst.Update
Loop
Close #intFileDesc
rst.Close
ReadFile = True

Exit_ReadFile:
Set rst = Nothing
Set dbs = Nothing
Exit Function

Err_ReadFile:
ReadFile = False
Resume Exit_ReadFile

End Function[/vba]

Now, from the form where you call this, you only need to do do:

[vba]If ReadFile Then
MsgBox "Import was successful.", vbInformation
Else
MsgBox "Import not successful.", vbExclamation
End If[/vba]

[mvidas]

Thanks Abulafia,
The only errors I encountered were when the last field(s) were blank, which resulted in the Mid not working. I just added an On Error Resume Next to it to skip those errors. The rest of it worked fine. I appreciate the error checking though, should come in handy for the future. I'll probably still just run this directly in a regular module, not sure why it's a function and not a sub. Runs fine either way though.
Any idea what I have to do to close this message?

[SJ McAbney]

I've closed it.