Visual Basic Programming
 
Forums: » Register « |  User CP |  Games |  Calendar |  Members |  FAQs |  Sitemap |  Support | 
 
 
User Name:
Password:
Remember me
Go Back   ASP Free ForumsProgrammingVisual Basic Programming

Reply
Add This Thread To:
  Del.icio.us   Digg   Google   Spurl   Blink   Furl   Simpy   Y! MyWeb 
Thread Tools Search this Thread Rate Thread Display Modes
 
Unread ASP Free Forums Sponsor:
  #1  
Old July 3rd, 2004, 12:57 PM
Preacha Preacha is offline
Registered User
ASP Free Newbie (0 - 499 posts)
 
Join Date: Jul 2004
Posts: 8 Preacha User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
Importing data into access

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 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 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 post up the code I have done in excel, to import the files. I just want to convert this into access, so I bypass excel

Reply With Quote
  #2  
Old July 3rd, 2004, 01:04 PM
Preacha Preacha is offline
Registered User
ASP Free Newbie (0 - 499 posts)
 
Join Date: Jul 2004
Posts: 8 Preacha User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
This is the code I have done in access (ignore some of the file direction links). I will put one more post up that continues this 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 ****()

'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

Reply With Quote
  #3  
Old July 3rd, 2004, 01:07 PM
Preacha Preacha is offline
Registered User
ASP Free Newbie (0 - 499 posts)
 
Join Date: Jul 2004
Posts: 8 Preacha User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
continued

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

Thanks guys, any help would be appreciated

Reply With Quote
  #4  
Old July 3rd, 2004, 09:07 PM
Doug G Doug G is offline
Grumpier Old Moderator
ASP Free God 11th Plane (10000 - 10499 posts)
 
Join Date: Sep 2003
Posts: 10,143 Doug G User rank is First Lieutenant (10000 - 20000 Reputation Level)Doug G User rank is First Lieutenant (10000 - 20000 Reputation Level)Doug G User rank is First Lieutenant (10000 - 20000 Reputation Level)Doug G User rank is First Lieutenant (10000 - 20000 Reputation Level)Doug G User rank is First Lieutenant (10000 - 20000 Reputation Level)Doug G User rank is First Lieutenant (10000 - 20000 Reputation Level)Doug G User rank is First Lieutenant (10000 - 20000 Reputation Level)Doug G User rank is First Lieutenant (10000 - 20000 Reputation Level) 
Time spent in forums: 3 Weeks 4 Days 23 h 29 m 58 sec
Reputation Power: 181
Well, I'm not going to wade through all that code

Was there a question somewhere that I missed?
__________________
======
Doug G
======
I didn't attend the funeral, but I sent a nice letter saying I approved of it. --Mark Twain

Reply With Quote
  #5  
Old July 3rd, 2004, 11:57 PM
Preacha Preacha is offline
Registered User
ASP Free Newbie (0 - 499 posts)
 
Join Date: Jul 2004
Posts: 8 Preacha User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
SQL errors

Well I have a possible solution. Using SQL statements, but I get the following error, "Runtime error: 3061" "Too few parameters. Expected 1". Does anyone know what this would mean? The code is below . .. .

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

The error occured next to the bold

Anyway, in answer to your question. I was just wondering how I would import the .TBL file ignoring the heading file and just import the columns of data?
Thankyou

Reply With Quote
Reply

Viewing: ASP Free ForumsProgrammingVisual Basic Programming > Importing data into access


Thread Tools  Search this Thread 
Search this Thread:

Advanced Search
Display Modes  Rate This Thread 
Rate This Thread:


Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
View Your Warnings | New Posts | Latest News | Latest Threads | Shoutbox
Forum Jump


Forums: » Register « |  User CP |  Games |  Calendar |  Members |  FAQs |  Sitemap |  Support | 
  
 





© 2003-2008 by Developer Shed. All rights reserved. DS Cluster 4 hosted by Hostway
Stay green...Green IT