-
Jul 9th, 2012, 02:36 PM
#1
Thread Starter
New Member
Push excel data to Access table - VB Application
So I have about 60 worksheets that I need to push into an access database (or sql). I'll be getting another 60 worksheets in 6 months, and another 60 after that.. so I wanted to build an app to do this work for me.
In visual studio 2008 I've built a project that loops through all my rows and columns, and pushes it into an access database. When I built this for another type of data, I used the exact same approach and got a quick and efficient tool, now I've built this tool and it is not efficient or fast.
It's a single sheet with anywhere from 5 to 50 columns of data, with 60,000 + rows (which is also variable). I tried basic for loops, but it takes hours to complete. Any advice to help speed up this code would be welcomed:
Code Snippit:
Code:
Public Sub ProcessSheet()
Dim StationID As String
Dim TimeStamp As Date
Dim MeasuredValue As Decimal
Dim ParameterName As String
Dim c As Integer
Dim r As Long
Dim strDestinationPathFile As String
Dim strPathFile As String
Dim StrCurYear As String
'Set and Open Access Database
strDestinationPathFile = Form1.TextBox2.Text
Dim conn As ADODB.Connection
conn = New ADODB.Connection
conn.Open("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDestinationPathFile & ";Persist Security Info=False;")
Processing = True
StrCurYear = DatePart(DateInterval.Year, Now())
StationID = Form1.ListBox1.SelectedItem.ToString
'Set and Open Excel Workbook
strPathFile = Form1.TextBox1.Text
Dim oExcel As Object
Dim wb As Object
oExcel = CreateObject("Excel.Application")
wb = oExcel.workbooks.open(strPathFile)
oExcel.Calculation = Microsoft.Office.Interop.Excel.XlCalculation.xlCalculationManual
'Loop across the Columns
For c = 3 To 75
If Len(wb.Sheets.Item(1).Cells(4, c).Value) = 0 Then Exit For
ParameterName = Trim(wb.Sheets.Item(1).Cells(4, c).Value)
'Loop down the rows
For r = 5 To 30000
If Len(Trim(wb.Sheets.Item(1).Cells(r, 2).Value)) = 0 Then Exit For
TimeStamp = CDate(wb.Sheets.Item(1).Cells(r, 2).Value)
If TimeStamp.Second() = 59 Then
TimeStamp = TimeStamp.AddSeconds(1)
End If
Dim cellvalue As String = wb.Sheets.Item(1).Cells(r, c).Value
If Len(Trim(cellvalue)) = 0 Then Continue For
MeasuredValue = CDec(Trim(wb.Sheets.Item(1).Cells(r, c).Value))
Dim strSQL As String
strSQL = "INSERT INTO WeatherData" & StrCurYear & " (StationID, TimeTag, Parameter, MeasuredValue, DateAdded) VALUES ('" & StationID & "',#" & TimeStamp & "#,'" & ParameterName & "'," & MeasuredValue & ",#" & Now() & "#)"
conn.Execute(strSQL)
Next
Thanks in advance!!
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|