Importing Alternative files

[Preacha]

Hi, There is a lot of code here, so bare with me
I'm currenlty working on a database that imports .TBL files into it, the format of the TBL files is (for example):

Operational mode: Speed/Classify, 12-class unidirectional File: 104.RTC
Area: 00 Site 004 Location: 02 Direction: Southbound
Description: NCLE INNER CITY BYP NORTH
Count interval: 15 min Detector: Tube Vehicle interval: n/a
Counter No: 3008 Firmware version: 2.04
Counter read at: 13:16:51 on 15/06/2004
First count recorded at: 16:00:00 on 11/06/2004
Last count ended at: 13:15:00 on 15/06/2004
Total vehicles recorded: 44696 Total axles recorded: 89429
Detector spacing: 1000mm Channel 1
Site log: ®empty¯
______________________________________________________________________

Date Time Cl Spd Unclass

11/06 16:00 1 63
11/06 16:00 1 64
11/06 16:00 1 60
11/06 16:00 1 59
11/06 16:00 1 56
11/06 16:00 1 54
11/06 16:00 1 61
11/06 16:00 1 63
11/06 16:00 1 61
11/06 16:00 1 54
11/06 16:00 1 56

As u can see, there is a header followed by columns of data. I want to import these columns into a specific table in the database without the header. I may also want to import specific information from the header into a separately table. Now I want to do this automatically using VBA code. I kinda have done a bit of it in excel, but I Want it so I don't have to import the spreadsheet into the access database, rather I want to import the above .TBL file directly. Now I want to do multiple files into the one table as well. and also, everytime I import stuff, I don't want to be importing the same data over and over again.

I started off doing a bit of coding but this is mainly for importing excel spreadsheets:

Function ImportSpreadsheet(tblname, filenm, rge)
DoCmd.TransferSpreadsheet transfertype:=acImport, _
spreadsheettype:=acSpreadsheetTypeExcel7, _
tablename:=tblname, _
filename:=filenm, _
hasfieldnames:=True, _
range:=rge
End Function

Function ImportTxtFile(tblname, filenm)
DoCmd.TransferText acExportDelim, _
specificationname:="Steves Spec name", _
tablename:=tblname, _
filename:=filenm, _
hasfieldnames:=True
End Function

Function OpenFile()
'Declaration of a variable as a FileDialog object.
Dim fd As FileDialog
'Creates a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declares a variable to contain the path
'of each selected item.
Dim vrtSelectedItem As Variant
'references the FileDialog object.
With fd
'displays the File Picker dialog box
If .Show = -1 Then
'Step through the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
If vrtSelectedItem = "C:\Documents and Settings\Steve\Desktop\counterDB\testSpeed.xls" Then
speedsheet = ImportSpreadsheet("tblSpeedTest", vrtSelectedItem, "A:Z")
Else: vrtSelectedItem = "C:\Documents and Settings\Steve\Desktop\counterDB\tempClassRTC.XLS"
classsheet = ImportSpreadsheet("tblClassTest", vrtSelectedItem, "A:Z")
End If
'If vrtSelectedItem Then
'blahtxt = ImportTxtFile("tblSpeedTest", vrtSelectedItem)
'Else: vrtSelectedItem
'blahtxt2 = ImportTxtFile("tblClassTest", vrtSelectedItem)
'End If
Next vrtSelectedItem
'The user pressed Cancel.
Else
'inp = InputBox("Would you like to import a text file or a spreadsheet?", "What would you like to do?")
'If inp = "text" Then
'MsgBox ("You have selected to import a text file")
'Else
'MsgBox ("You have selected to import a spreadsheet file")
'End If
MsgBox ("For future reference, it is preferable that you only select appropriate EXCEL and TBL files.")
End If
End With

'Sets the object variable to Nothing.
Set fd = Nothing

End Function

I will paste the code I used to import stuff in excel, in the next posts


Thanks guys, any help would be appreciated

 

[Preacha]

continued

Code I have done in excel to import the file and separate the header from the code

Public Sub speedCounts_Click()
SelectOpenCopySpeed
'preAccessSpeed
End Sub


Sub SelectOpenCopySpeed()

Dim i As Long
Dim vaFiles As Variant

vaFiles = Application.GetOpenFilename("TBL Files (*.tbl), *.tbl", _
Title:="Select files", MultiSelect:=True)

addNewSpeed

If IsArray(vaFiles) Then
For i = LBound(vaFiles) To UBound(vaFiles)

dataTransferSpeed (vaFiles(i))

Next i
End If

End Sub


Sub addNewSpeed()
Set NewBook = Workbooks.Add
With NewBook
.Title = "Converted TBL Files"
.Subject = "Traffic Counter Database"
End With
Application.DisplayAlerts = False
Worksheets("sheet2").Delete
Worksheets("sheet3").Delete
Application.DisplayAlerts = True
Worksheets(Sheets(1).Name).Name = "completedCounterData"

'puts in column headers

Worksheets("completedCounterData").Range("A1").Select
ActiveCell.FormulaR1C1 = "recordDates"
Worksheets("completedCounterData").Range("B1").Select
ActiveCell.FormulaR1C1 = "recordTimes"
Worksheets("completedCounterData").Range("C1").Select
ActiveCell.FormulaR1C1 = "Class"
Worksheets("completedCounterData").Range("D1").Select
ActiveCell.FormulaR1C1 = "Speed"
Worksheets("completedCounterData").Range("e1").Select
ActiveCell.FormulaR1C1 = "Unclass"
Worksheets("completedCounterData").Range("F1").Select
ActiveCell.FormulaR1C1 = "directionID"
Worksheets("completedCounterData").Range("G1").Select
ActiveCell.FormulaR1C1 = "description"
Worksheets("completedCounterData").Range("H1").Select
ActiveCell.FormulaR1C1 = "counterID"
Worksheets("completedCounterData").Range("I1").Select
ActiveCell.FormulaR1C1 = "fileNumber"
Worksheets("completedCounterData").Range("J1").Select
ActiveCell.FormulaR1C1 = "area"
Worksheets("completedCounterData").Range("K1").Select
ActiveCell.FormulaR1C1 = "site"
Worksheets("completedCounterData").Range("L1").Select
ActiveCell.FormulaR1C1 = "location"
Worksheets("completedCounterData").Range("M1").Select
ActiveCell.FormulaR1C1 = "downloadDate"

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\Steve\Desktop\counterDB\tempSpeedRTC.XLS"
Application.DisplayAlerts = True

End Sub

Sub dataTransferSpeed(strWbkName As String)

Dim wbkToCopy As Workbook
Set wbkToCopy = Workbooks.Open(Filename:=strWbkName)
Workbooks.OpenText Filename:= _
strWbkName, Origin:=932, StartRow:=1 _
, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False _
, Space:=True, Other:=False, OtherChar:=":", FieldInfo:=Array(Array(1, 2 _
), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1)), TrailingMinusNumbers:=True
createSheets
formatSheetsSpeed
dataSortSpeed

Worksheets("fileData").Activate

Worksheets("fileData").Select.SelectAll
Selection.Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:="false"
Application.DisplayAlerts = True

Workbooks("tempSpeedRTC.xls").Activate
Worksheets("completedCounterData").Activate
Application.Goto Reference:="R65536C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste


Worksheets("completedCounterData").Activate
Worksheets("completedCounterData").Cells.Select
Selection.EntireColumn.AutoFit


End Sub

Sub createSheets()
'creates a new worksheet and separates the data between the fileSpec & fileData worksheets
Sheets(Sheets(1).Name).Name = "fileData"
Sheets.Add
Sheets("Sheet1").Name = "fileSpec"
Worksheets("fileData").Range("1:12").Cut
ActiveSheet.Paste Destination:=Worksheets("fileSpec").Range("A1")
End Sub


Sub formatSheetsSpeed()

'formats the fileData worksheet
Worksheets("fileData").Activate

Worksheets("fileData").Activate
Worksheets("fileData").Rows("1:13").Select
Selection.Delete Shift:=xlUp
Worksheets("fileData").Rows("2:2").Select
Selection.Delete Shift:=xlUp
Worksheets("fileData").Range("A1").Select
Selection.Delete Shift:=xlToLeft


End Sub

Sub shit()

'Shift the appropriate data between forms
Worksheets("fileData").Activate
Worksheets("fileData").Range("G2").Select
ActiveCell.FormulaR1C1 = "=DAY(RC[-6])"
Worksheets("fileData").Range("H2").Select
ActiveCell.FormulaR1C1 = "=MONTH(RC[-7])"
Worksheets("fileData").Range("I2").Select
ActiveCell.FormulaR1C1 = "=YEAR(fileSpec!R[5]C[-2])"
Worksheets("fileData").Range("J2").Select
ActiveCell.FormulaR1C1 = "=HOUR(RC[-8])"
Worksheets("fileData").Range("K2").Select
ActiveCell.FormulaR1C1 = "=MINUTE(RC[-9])"
Worksheets("fileData").Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]=0,CONCATENATE(RC[-2],RC[-1])*10,CONCATENATE(RC[-2],RC[-1]))"
Worksheets("fileData").Range("L2").Select
Selection.Cut Destination:=Range("M2")
Worksheets("fileData").Range("L2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-5],R1C7,RC[-4],R1C7,RC[-3])"
Worksheets("fileData").Range("G1").Select
ActiveCell.FormulaR1C1 = "/"
Worksheets("fileData").Range("G2:M2").Select
Selection.AutoFill Destination:=Range("G2:M200")
Worksheets("fileData").Range("G2:M1589").Select
Worksheets("fileData").Range("I2").Select
ActiveCell.FormulaR1C1 = "=YEAR(fileSpec!R7C7)"
Worksheets("fileData").Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I200")
Worksheets("fileData").Range("I2:I1589").Select
Worksheets("fileData").Columns("B:B").Select
Selection.NumberFormat = "General"
Worksheets("fileData").Range("L2:M2").Select
Worksheets("fileData").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("fileData").Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("G:M").Select

Application.CutCopyMode = False
End Sub
Sub dataSortSpeed()

Worksheets("fileSpec").Activate

Worksheets("fileSpec").Range("B12").Select
ActiveCell.FormulaR1C1 = " "

Worksheets("fileSpec").Range("B14").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(R[-11]C,R[-2]C,R[-11]C[1],R[-2]C,R[-11]C[2],R[-2]C,R[-11]C[3],R[-2]C,R[-11]C[4],R[-2]C,R[-11]C[5],R[-2]C,R[-11]C[6])"

Worksheets("fileSpec").Range("B13").Select
ActiveCell.FormulaR1C1 = "=COUNT(fileData!C[-0])"

Count = Worksheets("fileSpec").Range("B13").Value

'Direction
For rwIndex = 2 To Count + 1
For colIndex = 6 To 6
With Worksheets("fileData").Cells(rwIndex, colIndex)
.Value = Worksheets("fileSpec").Cells(2, 8)
End With
Next colIndex
Next rwIndex

'Description
For rwIndex = 2 To Count + 1
For colIndex = 7 To 7
With Worksheets("fileData").Cells(rwIndex, colIndex)
.Value = Worksheets("fileSpec").Cells(14, 2)
End With
Next colIndex
Next rwIndex

'Counter Number
For rwIndex = 2 To Count + 1
For colIndex = 8 To 8
With Worksheets("fileData").Cells(rwIndex, colIndex)
.Value = Worksheets("fileSpec").Cells(5, 3)
End With
Next colIndex
Next rwIndex

'File Name
For rwIndex = 2 To Count + 1
For colIndex = 9 To 9
With Worksheets("fileData").Cells(rwIndex, colIndex)
.Value = Worksheets("fileSpec").Cells(1, 7)
End With
Next colIndex
Next rwIndex

'Area Number
For rwIndex = 2 To Count + 1
For colIndex = 10 To 10
With Worksheets("fileData").Cells(rwIndex, colIndex)
.Value = Worksheets("fileSpec").Cells(2, 2)
End With
Next colIndex
Next rwIndex

'Site Number
For rwIndex = 2 To Count + 1
For colIndex = 11 To 11
With Worksheets("fileData").Cells(rwIndex, colIndex)
.Value = Worksheets("fileSpec").Cells(2, 4)
End With
Next colIndex
Next rwIndex

'Location
For rwIndex = 2 To Count + 1
For colIndex = 12 To 12
With Worksheets("fileData").Cells(rwIndex, colIndex)
.Value = Worksheets("fileSpec").Cells(2, 6)
End With
Next colIndex
Next rwIndex

'Download Date
For rwIndex = 2 To Count + 1
For colIndex = 13 To 13
With Worksheets("fileData").Cells(rwIndex, colIndex)
.Value = Date
End With
Next colIndex
Next rwIndex

End Sub

 

[WayneRyan]

Preacha,

Here's a rough idea of what you can do.
Put this code on a Command Button.

Dim dbs As DAO.Database
Dim rst As DAO.RecordSet
Dim sql As String
Dim buf As String

'
' Open your file
'
Open "C:\YourDataFile.txt" For Input As #1
'
' Skip until there's a date
'
buf = "Starting ..."
While (Not IsDate(Mid(buf, 1, 5))) And Not EOF(1)
   Line Input #1, buf
   Wend
If EOF(1) Then
   MsgBox("Problems with the file.")
   Exit Sub
End If

'
' Process the file
'
'            +- Field1
'            |
'  TheDate   |  +- Field2
'     |      |  |
'     V      V  V
'=========== = ==
'11/06 16:00 1 63
'11/06 16:00 1 64
'11/06 16:00 1 60

Set dbs = CurrentDB
While Not EOF(1)
   '
   ' Does it exist in your table?
   '
   sql = "Select * " & _
         "From   YourTable " & _
         "Where  TheDate = #" & Mid(buf, 1, 11) & "#  And " & _
         "       Field1 = " & Mid(buf, 13, 1) & " And " & _
         "       Field2 = " & Mid(buf, 15, 1)
   Set rst = dbs.OpenRecordset(sql)
   If rst.EOF and rst.BOF Then
      '
      ' It is new, add it
      '
      rst.AddNew
      rst!TheDate = Mid(buf,  1, 11)
      rst!Field1  = Mid(buf, 13,  1)
      rst!Field2  = Mid(buf, 15,  1)
      rst.Update
   Else
      '
      ' It is already there, leave it
      '
   End If
   Set rst = Nothing
   Line Input #1, buf  ' Retrieve next line
   Wend
Close #1

Just a general idea, but hope that gets you started.

Wayne

 

[Preacha]

continued

Final part of the Code I have done in excel to import the file and separate the header from the code

Sub preAccessSpeed()
Workbooks("tempSpeedRTC").Worksheets("completedCounterData").Activate
Worksheets("completedCounterData").Range("X2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],[TBLtest.xls]Form!R2C5:R8C6,2)"
Worksheets("completedCounterData").Range("Y2").Select
ActiveCell.FormulaR1C1 = "=REPLACE(RC[-6],4,4,"""")"

Worksheets("completedCounterData").Range("X2:Y2").Select
Selection.AutoFill Destination:=Worksheets("completedCounterData").Range("X2:Y65336")

Worksheets("completedCounterData").Range("X2").Select
Worksheets("completedCounterData").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("completedCounterData").Range("P2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("completedCounterData").Range("X2").Select
Worksheets("completedCounterData").Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents

Worksheets("completedCounterData").Range("Y2").Select
Worksheets("completedCounterData").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("completedCounterData").Range("S2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("completedCounterData").Range("Y2").Select
Worksheets("completedCounterData").Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents

Workbooks("tempSpeedRTC.xls").Activate
Worksheets("completedCounterData").Activate
Application.Goto Reference:="R65536C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1:Z1").Select
Worksheets("completedCounterData").Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub

 

[Preacha]

cheers

Hmm thanks wayne, I'll look into that in the morning. I better go get some sleep

 

[Preacha]

SQL errors

Wayne, I have put that code in as you suggested (slightly modified), but I get the error "Runtime error: 3061" "Too few parameters. Expected 1", next to the below highlighted line I was just wondering what this mean't. Also, how would I check if the table exists? I roughly know how I would create a new one (using CREATE), but not sure how to check if the table exists :S

Option Compare Database

Private Sub Command0_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sql As String
Dim buf As String

'
' Open your file
'
Open "C:\Documents and Settings\Steve\Desktop\counterDB\Speed TBL's\104.TBL" For Input As #1
'
' Skip until there's a date
'
buf = "Starting ..."
While (Not IsDate(Mid(buf, 1, 5))) And Not EOF(1)
Line Input #1, buf
Wend
If EOF(1) Then
MsgBox ("Problems with the file.")
Exit Sub
End If

'
' Process the file
'
' +- Field1
' |
' TheDate | +- Field2
' | | |
' V V V
'=========== = ==
'11/06 16:00 1 63
'11/06 16:00 1 64
'11/06 16:00 1 60

Set dbs = CurrentDb
While Not EOF(1)
'
' Does it exist in your table?
'
sql = "SELECT * " & _
"FROM SpeedImport " & _
"WHERE Date = #" & Mid(buf, 1, 5) & "# AND " & _
"Time = #" & Mid(buf, 7, 5) & "# AND " & _
"Cl = " & Mid(buf, 14, 1) & " AND " & _
"Speed = " & Mid(buf, 16, 3)
Set rst = dbs.OpenRecordset(sql)
If rst.EOF And rst.BOF Then
'
' It is new, add it
'
rst.AddNew
rst!Date = Mid(buf, 1, 5)
rst!Time = Mid(buf, 7, 5)
rst!Cl = Mid(buf, 14, 1)
rst!Speed = Mid(buf, 16, 3)
rst.Update
Else
'
' It is already there, leave it
'
End If
Set rst = Nothing
Line Input #1, buf ' Retrieve next line
Wend
Close #1
End Sub

 

[WayneRyan]

Preacha,

You can't call your field Date. Access has that reserved. Change it and
let me know in a few minutes.

Wayne

 

[Preacha]

still got the same problem

I change the fields to RecordDate and RecordTime and still got the same error message.

 

[Preacha]

Further Problem

Also, how would I got about extracting information from the header? i.e. I would like to put "Direction", "Description", "CounterNo", "FileNumber", "Area", "Site", "location" and "Download Date"(Today) each in separate columns on the same table for above.
Thanks

 

[WayneRyan]

Preacha,

If you can post an DB with no data (but have your tables there), and a
sample of the data. I'll give it a try later.

Wayne

 

[Preacha]

hmm

It works if I remove the SQL stuff and ignore the checks if the data is available, but I'd like to have that so it doesn't paste the same data over and over again

 

[WayneRyan]

Preacha,

Well, you kinda need the SQL stuff. Here's an idea ...

Get the code in Design View. Click on the left margin on an executable line
of code. This is a breakpoint. When your code runs it will stop here.

F8 will single-step you through the code
Ctrl-F9 will set the next line to execute.
If you hover over a variable, it will show its value.

This way you can look at things while it runs.

You can also use the Menu Bar and select View --> Immediate Window

Then you can type:

?rst!SomeField and see its value

Or

?strSQL

and see the whole value.

Experiment and let you know.

Also, you don't really want "every" record to have the header information!
It should be in another table. We'll save that for later though.

Wayne

 

[WayneRyan]

Preacha,

Also, the "too few parameters" generally means that your SQL is
referencing a column that doesn't exist. You must have its name
wrong.

Wayne

 

[Preacha]

SQL not good

I should actually take out that SQL stuff because I need all the fields . (including repeating values). I just wanted it so that you don't add all of the same file again

 

[WayneRyan]

Preacha,

I don't understand. You want the repeat records, BUT not the entire
file? Does some other software, just keep appending to the file?

Did you look at the SQL string in the immediate window?

?strSQL

Still need more info ...

Wayne

 

[Preacha]

well if you notice that in the above file that there are repeating values. Putting in the SQL code only enters values once (with no repeats). I've just got "SELECT * From Table " atm, this works ok. You wouldn't know how to reset autonumber using VBA, would you? Like I've put "RecordNo" as the first field to uniquely identify each record. But when I clear the contents of the table, it continues on from the last record number. For example if I import a file with 8 records, then decide I want to clear the contents access continues from number 8. I don't want this atm. I want to reset the field number. Still gotta work on extracting the headers from the TBL files. I think I will just import the whole file and ignore lines after the linebreak. I will import this header into a separate table.
Thanks heaps for heaping me with this

 

[Preacha]

I just realised (I'm slow ) That that last row is not being imported. For example, for a TBL file with 10 rows, It is only importing 9. Weird. Do you know what the problem would be here?

 

[WayneRyan]

Preacha,

AutoNumbers are good things. Their only purpose is to provide a
unique record ID. All that means is that it has its OWN number,
noone else has it. Keep it, but only display the ones that make
sense to people.

Good to see the header separate table.

As for reading the last record, it depends how the loop is
controlled:

Read Record
While Not EOF(1)
   Process Record
   Read Record
   Wend

In the above all records will be processed.

If you try to control it with a For statement, you can tend
to miss records on the +/- side.

Running it with the debugger can clearly illustrate problem
areas.

Since this is not a one-time shot, I'm curious as to the
content of subsequent files received. If the file is just
being constantly APPENDED to that introduces a lot of new
issues. Is that why the AutoNumber is bothering you.

Just some thoughts,
Wayne

 

[Preacha]

I may need to clear the data on the table, thats all. I just want it so that it resets the autonumber starting number back to 1 again