MS Excel不使用Access数据库进行更新。 VB6

时间:2014-02-21 01:25:15

标签: excel datagrid vb6

我创建了一个表单,当我单击一个按钮(subMnuPrintStaff)时,它应该打开一个Excel文件(WorkerNames.xls)。 Excel文件从我的数据库(Employee.mdb)获取其记录。但问题是,当我更新我的数据库文件(Employee.mdb)时,我的Excel文件上的记录不会更新。我该如何解决? 我正在使用flexgrid。

按钮代码:

Private Sub subMnuPrintStaff_Click()
'On Error GoTo er
Dim oExcel As Object
Set oExcel = CreateObject("Excel.Application")
Dim oWorkBook As Object
Dim oWorkSheet As Object
Dim i As Integer, k As Integer
Dim lRow As Long
Dim LastRow As Long
Dim LastCol As Long

oExcel.Visible = False
oExcel.Workbooks.Open App.Path & "\WorkerNames.xls"
Set oWorkSheet = oExcel.Workbooks("WorkerNames.xls").Sheets("WorkerNames")

i = 2 'Row in Excel

LastRow = DataGrid1.Row 'Save Current row
LastCol = DataGrid1.Col 'and column
DataGrid1.Row = 0 'Fixed Row is -1
Do While DataGrid1.Row <= DataGrid1.VisibleRows - 1
     For k = 1 To DataGrid1.Columns.Count - 1
          DataGrid1.Col = k 'Fixed Column is -1
          oWorkSheet.Cells(i, k).Font.Bold = False
          oWorkSheet.Cells(i, k).Font.Color = vbBlack
          oWorkSheet.Cells(i, k).Value = DataGrid1.Text
     Next
     i = i + 1
     If DataGrid1.Row < DataGrid1.VisibleRows - 1 Then
        DataGrid1.Row = DataGrid1.Row + 1
     Else
         Exit Do
     End If
Loop
DataGrid1.Row = LastRow 'Restore original Row
DataGrid1.Col = LastCol 'and Column

oExcel.Workbooks("WorkerNames.xls").Save
oExcel.Workbooks("WorkerNames.xls").Close savechanges:=True
oExcel.Quit
'cmdView.Enabled = True
'er:
'If err.Number = 1004 Then
'Exit Sub
'End If

On Error GoTo ErrHandler
    Dim xlApp As Object
    Dim xlWB As Object

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True

    Set xlWB = xlApp.Workbooks.Open("WorkerNames.xls")
    Exit Sub

ErrHandler:
    MsgBox "There is a problem opening that workbook!", vbCritical, "Error!"
End Sub

FORM LOAD CODE:

Dim oRs As New ADODB.Recordset
  Dim adoConn2 As ADODB.Connection

  Set adoConn2 = New ADODB.Connection

  adoConn2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source = " & App.Path & "\Employee.mdb"
  adoConn2.Open
oRs.CursorLocation = adUseClient
  oRs.Open "select * from employeeName", adoConn2, adOpenKeyset, adLockPessimistic

  Set DataGrid1.DataSource = oRs

  DataGrid1.Refresh

非常感谢任何帮助。数据库和Excel文件与项目位于同一目录中。

将数据保存到我的数据库中的代码 - 使用文本框

Dim adoConn As New ADODB.Connection Dim constr, curSql As String constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\employee.mdb;Persist Security Info=False" 

Set adoConn = New ADODB.Connection 
adoConn.ConnectionString = constr adoConn.Open 

If txtFirstName.Text = "" Or txtLastName.Text = "" Then 
               MsgBox "Some fields are empty!", vbInformation + vbOKOnly, "Empty Fields" 

Else curSql = "INSERT INTO employeename(Firstname, LastName) VALUES ("curSql = curSql & "'" & Replace(txtFirstName.Text, "'", "''") & "'," curSql = curSql & "'" & Replace(txtLastName.Text, "'", "''") & "')"

 adoConn.Execute curSql 
adoConn.Close 

MsgBox "Data successfully added!", vbOKOnly, "Success!"

 txtFirstName.Text = "" 
txtLastName.Text = "" 

0 个答案:

没有答案