F
Frank Bacon
The following code takes data from excel spreadsheets adds a record to the
dataset and puts the excel cell value in the correct column. It uses an
oleCommandBuilder to generate the proper SQL Insert statement. I get the
excel sheets open and extract the data, add a new row and populate it with
data, add the row to the dataset but the app doesn't update the Database.
What am I missing?
Private Sub butRunFullUpdate_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles butRunFullUpdate.Click
Dim strXLFileName As String
Dim strSql As String
'Declare ADO Components
Dim dsDbTables As DataSet 'to hold Names of SpreadSheets
Dim dsMaps As DataSet 'to hold Names of Maps (Cell Ranges)
Dim dsVarTables As DataSet 'to hold respective VAR Table
Dim dtDBTables As DataTable
Dim dtMaps As DataTable ' Holds Spreadsheet Cell addresses
Dim dtVarTables As DataTable ' Holds Table Names
Dim dcSheetName As DataColumn
Dim dcMaps As DataColumn
Dim drMaps As DataRow
Dim NewRow As DataRow
Dim drVarTables As DataRow
Dim daVarTables As OleDbDataAdapter
Dim oleCB As OleDbCommandBuilder
Dim oleDBC As OleDbCommand
Dim strSpreadSheetName As String
Dim strSpreadSheet As String
Dim strTemp As String
Dim strDate As String
Dim strTableName As String
Dim vCellValue As Object
Dim indx As Integer
Dim i As Integer
Dim dVar As Double
Dim RecUpdated As Integer
' Clear display & wipe out Display and Notification lable
rtbDisplay.Clear()
lblUserMessage.Text = ""
'Get the File name with common dialog
strXLFileName = GetFileName()
StatusBar1.Text = "Processing..."
'Create a dataset and currency manager to get spreadsheets names
strSql = "Select * FROM SpreadsheetMap;" ' list of spreadsheet names in
file
dsDbTables = CreateDataSet(strSql, myConnection)
dtDBTables = dsDbTables.Tables(0)
objXlApp = CreateObject("Excel.Application")
ObjXlBook = objXlApp.Workbooks.Add(strXLFileName)
'Loops Through Spreadsheet list accessing Mapnames and Table Names
indx = 0
For Each dcSheetName In dtDBTables.Columns
i = 0
'Get Spreadsheet name from SpreadSheetMap and creates SpreadSheet
strSpreadSheetName = dtDBTables.Rows(0).Item(indx)
XlSheet = ObjXlBook.Worksheets.Item(strSpreadSheetName)
'Loops Map of tables
'Open appropriate Map - List of Cells in spreadsheet
strSql = "Select * FROM [" + CStr(dcSheetName.ColumnName) + " Map];"
dsMaps = CreateDataSet(strSql, myConnection)
dtMaps = dsMaps.Tables(0)
'Get latest Mapping
drMaps = dtMaps.Rows(dtMaps.Rows.Count - 1)
'Open Appropriate VAR Table
strSql = "Select * FROM [" + CStr(dcSheetName.ColumnName) + "] ORDER BY
[Date];"
dsVarTables = CreateDataSet(strSql, myConnection)
dtVarTables = dsVarTables.Tables(0)
'Go to Latest Record
drVarTables = dtVarTables.Rows(dtVarTables.Rows.Count - 1)
'Print out the Spreadsheet Name and 2 line feeds
rtbDisplay.Text = rtbDisplay.Text + strSpreadSheetName + vbCrLf + vbCrLf
daVarTables = New OleDbDataAdapter()
daVarTables.SelectCommand = New OleDbCommand(strSql, myConnection)
oleCB = New OleDbCommandBuilder(daVarTables)
'oleDBC = oleCB.GetInsertCommand
'strSql = oleDBC.CommandText
'MsgBox(strSql)
daVarTables.Fill(dsVarTables, dcSheetName.ColumnName)
NewRow = dsVarTables.Tables(dcSheetName.ColumnName).NewRow()
For Each dcMaps In dtMaps.Columns
'If...Then ... Else required to catch Empty values in data
If dcMaps.ColumnName = "DateChanged" Then 'Do nothing for date of
Map Change
ElseIf dcMaps.ColumnName = "Date" Then
'Process Date info
strTemp = CStr(dtMaps.Rows(dtMaps.Rows.Count - 1).Item(i))
strDate =
CStr(ObjXlBook.Worksheets(strSpreadSheetName).Range(strTemp).value)
NewRow("Date") = strDate.Substring(23, (strDate.Length - 23))
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1), MsgBoxStyle.OKOnly)
Else
If dtMaps.Rows(dtMaps.Rows.Count - 1).IsNull(i) Then
NewRow(dcMaps.ColumnName) = 0
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1),
MsgBoxStyle.OKOnly)
Else
strTemp = dtMaps.Rows(dtMaps.Rows.Count - 1).Item(i)
'Offset on index(i) required because Var Map contains extra
Column
If dtVarTables.Rows(dtVarTables.Rows.Count - 1).IsNull(i - 1)
Then
vCellValue =
ObjXlBook.Worksheets(strSpreadSheetName).Range(strTemp).value
rtbDisplay.Text = rtbDisplay.Text + dcMaps.ColumnName +
vbTab _
+ Format(CStr(vCellValue), "Currency") + vbCrLf
If CStr(vCellValue) = " " Then
NewRow(dcMaps.ColumnName) = 0
'MsgBox(CStr(i) & "" & NewRow.Item(i - 1),
MsgBoxStyle.OKOnly)
Else
NewRow(dcMaps.ColumnName) = CDbl(vCellValue)
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1),
MsgBoxStyle.OKOnly)
End If
Else
'Offset on index(i) required because Var Map contains extra Column
dVar = dtVarTables.Rows(dtVarTables.Rows.Count - 1).Item(i - 1)
vCellValue =
ObjXlBook.Worksheets(strSpreadSheetName).Range(strTemp).value
rtbDisplay.Text = rtbDisplay.Text + dcMaps.ColumnName + vbTab _
+ Format(CStr(vCellValue), "Currency") + _
" " + Format(CStr(dVar), "Currency") + vbCrLf
If CStr(vCellValue) = " " Then
NewRow(dcMaps.ColumnName) = 0
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1), MsgBoxStyle.OKOnly)
Else
NewRow(dcMaps.ColumnName) = CDbl(vCellValue)
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1), MsgBoxStyle.OKOnly)
End If
End If
End If
End If
i = i + 1
Next
Try
strTableName = dcSheetName.ColumnName
dsVarTables.Tables(strTableName).Rows.Add(NewRow)
Dim dsChanges As DataSet = dsVarTables.GetChanges()
strSql = CStr(NewRow.RowState())
dbgChanges.DataSource = dsVarTables.Tables(dcSheetName.ColumnName)
dbgChanges.Refresh()
If Not dsChanges Is Nothing Then
RecUpdated = daVarTables.Update(dsChanges)
End If
dsChanges = Nothing
Catch err As Exception
MessageBox.Show(err.Message)
End Try
'MsgBox((dcSheetName.ColumnName) + Str(RecUpdated) + " records
Updated", MsgBoxStyle.OKOnly)
'Cleanup variables
NewRow = Nothing
oleCB = Nothing
daVarTables = Nothing
dsVarTables = Nothing
dtVarTables = Nothing
dsMaps = Nothing
dtMaps = Nothing
indx = indx + 1
rtbDisplay.Text = rtbDisplay.Text + vbCrLf
Next
'Clean Up
dtDBTables = Nothing
dsDbTables = Nothing
'objTemp = Nothing
StatusBar1.Text = "Update Completed!"
lblUserMessage.Text = "Record Updated"
butRunFullUpdate.Enabled = False
End Sub
dataset and puts the excel cell value in the correct column. It uses an
oleCommandBuilder to generate the proper SQL Insert statement. I get the
excel sheets open and extract the data, add a new row and populate it with
data, add the row to the dataset but the app doesn't update the Database.
What am I missing?
Private Sub butRunFullUpdate_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles butRunFullUpdate.Click
Dim strXLFileName As String
Dim strSql As String
'Declare ADO Components
Dim dsDbTables As DataSet 'to hold Names of SpreadSheets
Dim dsMaps As DataSet 'to hold Names of Maps (Cell Ranges)
Dim dsVarTables As DataSet 'to hold respective VAR Table
Dim dtDBTables As DataTable
Dim dtMaps As DataTable ' Holds Spreadsheet Cell addresses
Dim dtVarTables As DataTable ' Holds Table Names
Dim dcSheetName As DataColumn
Dim dcMaps As DataColumn
Dim drMaps As DataRow
Dim NewRow As DataRow
Dim drVarTables As DataRow
Dim daVarTables As OleDbDataAdapter
Dim oleCB As OleDbCommandBuilder
Dim oleDBC As OleDbCommand
Dim strSpreadSheetName As String
Dim strSpreadSheet As String
Dim strTemp As String
Dim strDate As String
Dim strTableName As String
Dim vCellValue As Object
Dim indx As Integer
Dim i As Integer
Dim dVar As Double
Dim RecUpdated As Integer
' Clear display & wipe out Display and Notification lable
rtbDisplay.Clear()
lblUserMessage.Text = ""
'Get the File name with common dialog
strXLFileName = GetFileName()
StatusBar1.Text = "Processing..."
'Create a dataset and currency manager to get spreadsheets names
strSql = "Select * FROM SpreadsheetMap;" ' list of spreadsheet names in
file
dsDbTables = CreateDataSet(strSql, myConnection)
dtDBTables = dsDbTables.Tables(0)
objXlApp = CreateObject("Excel.Application")
ObjXlBook = objXlApp.Workbooks.Add(strXLFileName)
'Loops Through Spreadsheet list accessing Mapnames and Table Names
indx = 0
For Each dcSheetName In dtDBTables.Columns
i = 0
'Get Spreadsheet name from SpreadSheetMap and creates SpreadSheet
strSpreadSheetName = dtDBTables.Rows(0).Item(indx)
XlSheet = ObjXlBook.Worksheets.Item(strSpreadSheetName)
'Loops Map of tables
'Open appropriate Map - List of Cells in spreadsheet
strSql = "Select * FROM [" + CStr(dcSheetName.ColumnName) + " Map];"
dsMaps = CreateDataSet(strSql, myConnection)
dtMaps = dsMaps.Tables(0)
'Get latest Mapping
drMaps = dtMaps.Rows(dtMaps.Rows.Count - 1)
'Open Appropriate VAR Table
strSql = "Select * FROM [" + CStr(dcSheetName.ColumnName) + "] ORDER BY
[Date];"
dsVarTables = CreateDataSet(strSql, myConnection)
dtVarTables = dsVarTables.Tables(0)
'Go to Latest Record
drVarTables = dtVarTables.Rows(dtVarTables.Rows.Count - 1)
'Print out the Spreadsheet Name and 2 line feeds
rtbDisplay.Text = rtbDisplay.Text + strSpreadSheetName + vbCrLf + vbCrLf
daVarTables = New OleDbDataAdapter()
daVarTables.SelectCommand = New OleDbCommand(strSql, myConnection)
oleCB = New OleDbCommandBuilder(daVarTables)
'oleDBC = oleCB.GetInsertCommand
'strSql = oleDBC.CommandText
'MsgBox(strSql)
daVarTables.Fill(dsVarTables, dcSheetName.ColumnName)
NewRow = dsVarTables.Tables(dcSheetName.ColumnName).NewRow()
For Each dcMaps In dtMaps.Columns
'If...Then ... Else required to catch Empty values in data
If dcMaps.ColumnName = "DateChanged" Then 'Do nothing for date of
Map Change
ElseIf dcMaps.ColumnName = "Date" Then
'Process Date info
strTemp = CStr(dtMaps.Rows(dtMaps.Rows.Count - 1).Item(i))
strDate =
CStr(ObjXlBook.Worksheets(strSpreadSheetName).Range(strTemp).value)
NewRow("Date") = strDate.Substring(23, (strDate.Length - 23))
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1), MsgBoxStyle.OKOnly)
Else
If dtMaps.Rows(dtMaps.Rows.Count - 1).IsNull(i) Then
NewRow(dcMaps.ColumnName) = 0
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1),
MsgBoxStyle.OKOnly)
Else
strTemp = dtMaps.Rows(dtMaps.Rows.Count - 1).Item(i)
'Offset on index(i) required because Var Map contains extra
Column
If dtVarTables.Rows(dtVarTables.Rows.Count - 1).IsNull(i - 1)
Then
vCellValue =
ObjXlBook.Worksheets(strSpreadSheetName).Range(strTemp).value
rtbDisplay.Text = rtbDisplay.Text + dcMaps.ColumnName +
vbTab _
+ Format(CStr(vCellValue), "Currency") + vbCrLf
If CStr(vCellValue) = " " Then
NewRow(dcMaps.ColumnName) = 0
'MsgBox(CStr(i) & "" & NewRow.Item(i - 1),
MsgBoxStyle.OKOnly)
Else
NewRow(dcMaps.ColumnName) = CDbl(vCellValue)
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1),
MsgBoxStyle.OKOnly)
End If
Else
'Offset on index(i) required because Var Map contains extra Column
dVar = dtVarTables.Rows(dtVarTables.Rows.Count - 1).Item(i - 1)
vCellValue =
ObjXlBook.Worksheets(strSpreadSheetName).Range(strTemp).value
rtbDisplay.Text = rtbDisplay.Text + dcMaps.ColumnName + vbTab _
+ Format(CStr(vCellValue), "Currency") + _
" " + Format(CStr(dVar), "Currency") + vbCrLf
If CStr(vCellValue) = " " Then
NewRow(dcMaps.ColumnName) = 0
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1), MsgBoxStyle.OKOnly)
Else
NewRow(dcMaps.ColumnName) = CDbl(vCellValue)
'MsgBox(CStr(i) & " " & NewRow.Item(i - 1), MsgBoxStyle.OKOnly)
End If
End If
End If
End If
i = i + 1
Next
Try
strTableName = dcSheetName.ColumnName
dsVarTables.Tables(strTableName).Rows.Add(NewRow)
Dim dsChanges As DataSet = dsVarTables.GetChanges()
strSql = CStr(NewRow.RowState())
dbgChanges.DataSource = dsVarTables.Tables(dcSheetName.ColumnName)
dbgChanges.Refresh()
If Not dsChanges Is Nothing Then
RecUpdated = daVarTables.Update(dsChanges)
End If
dsChanges = Nothing
Catch err As Exception
MessageBox.Show(err.Message)
End Try
'MsgBox((dcSheetName.ColumnName) + Str(RecUpdated) + " records
Updated", MsgBoxStyle.OKOnly)
'Cleanup variables
NewRow = Nothing
oleCB = Nothing
daVarTables = Nothing
dsVarTables = Nothing
dtVarTables = Nothing
dsMaps = Nothing
dtMaps = Nothing
indx = indx + 1
rtbDisplay.Text = rtbDisplay.Text + vbCrLf
Next
'Clean Up
dtDBTables = Nothing
dsDbTables = Nothing
'objTemp = Nothing
StatusBar1.Text = "Update Completed!"
lblUserMessage.Text = "Record Updated"
butRunFullUpdate.Enabled = False
End Sub