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]

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").Sel ect
ActiveCell.FormulaR1C1 = "recordDates"
Worksheets("completedCounterData").Range("B1").Sel ect
ActiveCell.FormulaR1C1 = "recordTimes"
Worksheets("completedCounterData").Range("C1").Sel ect
ActiveCell.FormulaR1C1 = "Class"
Worksheets("completedCounterData").Range("D1").Sel ect
ActiveCell.FormulaR1C1 = "Speed"
Worksheets("completedCounterData").Range("e1").Sel ect
ActiveCell.FormulaR1C1 = "Unclass"
Worksheets("completedCounterData").Range("F1").Sel ect
ActiveCell.FormulaR1C1 = "directionID"
Worksheets("completedCounterData").Range("G1").Sel ect
ActiveCell.FormulaR1C1 = "description"
Worksheets("completedCounterData").Range("H1").Sel ect
ActiveCell.FormulaR1C1 = "counterID"
Worksheets("completedCounterData").Range("I1").Sel ect
ActiveCell.FormulaR1C1 = "fileNumber"
Worksheets("completedCounterData").Range("J1").Sel ect
ActiveCell.FormulaR1C1 = "area"
Worksheets("completedCounterData").Range("K1").Sel ect
ActiveCell.FormulaR1C1 = "site"
Worksheets("completedCounterData").Range("L1").Sel ect
ActiveCell.FormulaR1C1 = "location"
Worksheets("completedCounterData").Range("M1").Sel ect
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]

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("completedCou nterData").Activate
Worksheets("completedCounterData").Range("X2").Sel ect
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],[TBLtest.xls]Form!R2C5:R8C6,2)"
Worksheets("completedCounterData").Range("Y2").Sel ect
ActiveCell.FormulaR1C1 = "=REPLACE(RC[-6],4,4,"""")"

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

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

Worksheets("completedCounterData").Range("Y2").Sel ect
Worksheets("completedCounterData").Range(Selection , Selection.End(xlDown)).Select
Selection.Copy
Worksheets("completedCounterData").Range("S2").Sel ect
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("completedCounterData").Range("Y2").Sel ect
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]

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

[Preacha]

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]

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

[Preacha]

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]

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]

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