|
|
|||||||||
|
|||||||||
|
|||||||||
| |
||
| |||||||||
![]() |
|
|
«
Previous Thread
|
Next Thread
»
|
Thread Tools | Search this Thread | Rate Thread | Display Modes |
|
#1
|
|||
|
|||
|
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 |
|
#2
|
|||
|
|||
|
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 |
|
#3
|
|||
|
|||
|
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 |
|
#4
|
|||
|
|||
|
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 |
|
#5
|
|||
|
|||
|
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 |
![]() |
| Viewing: ASP Free Forums > Programming > Visual Basic Programming > Importing data into access |
| Thread Tools | Search this Thread |
| Display Modes | Rate This Thread |
|
|
|
|