返回列表 上一主題 發帖

[發問] Excel工作表單與Access資料庫的VBA互動問題

[發問] Excel工作表單與Access資料庫的VBA互動問題

說明:
原本這是前陣子一位麻辣網友的提問,於日前完成撰寫後,
卻忘了該提問是哪一篇,所以再次代為提文。

A.  Excel Data  -  從 "data" 工作表單直接存取資料、      
    SQL Data    -  從 Access 資料庫 DataSrc 存取資料
    當輸入 "名字" 後,按下 "輸入確定",
    程式即根據 "Excel Data" 或 "SQL Data" 做資料篩選,
    如資料不存在,則右上端顯示 "新增資料", 反之 "更新資料"。
B.  無論是選擇 "Excel Data" 或 "SQL Data" 於資料儲存時,均會
    同步寫入至 Excel "data" 工作表單,以及對應之 Access 資料庫。
C.  目前只能處裡 Access MDF 的資料庫, 2010 的 ACCDB 資料庫在
    存取上遇到瓶頸,會於 rs.Open strSQL, cnn, 1, 3 讀取處出現
    錯誤訊息,一直無解,尚請各位大大鼎力協助解決,謝謝大家!
D.  簽證費用、機票費用的加總計算處理,因卡在 C 項的問題,故尚未處裡。
E.  這是一篇我個人認為蠻能玩味的程式撰寫,希望大家共襄盛舉。
01.png
2013-12-8 19:44

02.png
2013-12-8 19:44

回復 1# c_c_lai
附上程式:
2014年機票記錄.rar (68.94 KB)

TOP

回復 2# c_c_lai
Acess 資料庫:
機票記錄明細表.mdb
機票記錄明細表檔案.accdb  (For 2010)
2014年機票記錄db.rar (29.21 KB)
尚請各位大大鼎力協助解決,謝謝大家!

TOP

本帖最後由 c_c_lai 於 2013-12-9 08:55 編輯

回復 3# c_c_lai
因為有些會員因目前尚無法下載,所以將程式碼貼上,
尚請各位大大鼎力幫忙,解決處理 Access 2010 VBA 連結問題,
在此先行說聲謝謝幫忙!
  1. '  [ThisWorkbook]
  2. Option Explicit

  3. Private Sub Workbook_Open()
  4.     With Sheets("機票作業")
  5.         .ExcelData.Value = True
  6.         .SQLData.Value = False
  7.         .CallID.Value = ""
  8.         .DateTime.Value = ""
  9.         .RecordExisted.Caption = ""
  10.         .Activate
  11.         .SaveData.Enabled = False
  12.         .ResetData.Enabled = False
  13.         .ResetData_Click
  14.     End With
  15. End Sub
複製代碼

TOP

回復 4# c_c_lai
  1. '  [Sheet1 (機票作業)]
  2. Option Explicit
  3. Option Base 1

  4. Dim cnn As Object      '  New ADODB.Connection
  5. Dim cmd As Object      '  New ADODB.Command
  6. Dim rs As Object       '  New ADODB.Recordset
  7. Dim strSQL As String
  8. Dim editMode As Boolean
  9. Dim State, CursorLocation

  10. Sub OpenDB()
  11.     If ExcelData.Value = True Then    '  [data$]
  12.         Set cnn = CreateObject("ADODB.Connection")
  13.         Set rs = CreateObject("ADODB.Recordset")
  14.         Set cmd = CreateObject("ADODB.Command")
  15.     Else                              '  機票紀錄
  16.         Set cnn = New ADODB.Connection
  17.         Set rs = New ADODB.Recordset
  18.         Set cmd = New ADODB.Command
  19.     End If
  20.     '  ObjectStateEnum Values
  21.     '  Returns a value describing if the connection is open or closed
  22.     '  Specifies whether an object is open or closed, connecting to a data source,
  23.     '  executing a command, or retrieving data.
  24.     '  --------------------------------------------------------------------------
  25.     '  Constant             Value     Description
  26.     '  --------------------------------------------------------------------------
  27.     '  adStateClosed          0       The object is closed
  28.     '  adStateOpen            1       The object is open
  29.     '  adStateConnecting      2       The object is connecting
  30.     '  adStateExecuting       4       The object is executing a command
  31.     '  adStateFetching        8       The rows of the object are being retrieved
  32.     With cnn
  33.         If .State = 1 Then .Close    '  adStateOpen
  34.         
  35.         If ExcelData.Value = True Then
  36.             .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
  37.                                 ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
  38.         Else
  39.             .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & _
  40.                               ThisWorkbook.Path & Application.PathSeparator & "機票記錄明細表.mdb" & ";"
  41.             '  For Microsoft.ACE.OLEDB.12.0,you need Microsoft Office 12.0 Access Database Engine to be installed.
  42.             '  .ConnectionString = "Provider=Microsoft.Ace.OLEDB.12.0;" & "Data Source=" & _
  43.             '                    ThisWorkbook.Path & Application.PathSeparator & "機票記錄明細表檔案.accdb" & ";"
  44.         End If
  45.         .Open
  46.     End With
  47. End Sub

  48. Sub closeRS()
  49.     With rs
  50.         If ExcelData.Value = False Then
  51.             If .State = 1 Then .Close    '  adStateOpen
  52.             '  The CursorLocation property is used to set or return the location of the cursor.
  53.             '  This property can be set to one of the CursorLocationEnum constants listed in the following table.
  54.             '  Enumeratio0n     Value   Description
  55.             '  adUseNone          1     This value indicates no cursor location.
  56.             '                           This value is not supported by the MicrosoftR OLE DB Provider for AS/400 and VSAM.
  57.             '  adUseServer        2     This value indicates that the data provider or driver-supplied cursor is used.
  58.             '  adUseClient        3     This value indicates that a client-side cursor supplied by a local cursor library
  59.             '                           is to be used.
  60.             '  adUseClientBatch   3     For backward compatibility, this value indicates that a client-side cursor supplied by
  61.             '                           a local cursor library is to be used.
  62.             .CursorLocation = 3          '  adUseClient
  63.         Else
  64.             If State = 1 Then .Close    '  adStateOpen
  65.             CursorLocation = 3          '  adUseClient
  66.         End If
  67.     End With
  68. End Sub

  69. Private Sub ExcelData_Click()
  70.     '  MsgBox "Option is Excel Data "
  71. End Sub

  72. Private Sub SQLData_Click()
  73.     '  MsgBox "Option is SQL Data "
  74. End Sub

  75. Private Sub UpdateDropDowns()
  76.     If ExcelData.Value = True Then
  77.         strSQL = "Select Distinct [簽證內容] From [簽證項目$] Order by [簽證內容]"
  78.     Else
  79.         strSQL = "Select Distinct 簽證內容 From 簽證項目 Order by 簽證內容"
  80.     End If
  81.    
  82.     '  closeRS
  83.     OpenDB
  84.     License1.Clear
  85.     License2.Clear
  86.    
  87.     rs.Open strSQL, cnn, 1, 3     '  adOpenKeyset, adLockOptimistic
  88.     If rs.RecordCount > 0 Then
  89.         Do While Not rs.EOF
  90.             License1.AddItem rs.Fields(0)    '  Select Distinct [簽證內容] From
  91.             License2.AddItem rs.Fields(0)    '  Select Distinct [簽證內容] From
  92.             rs.MoveNext
  93.         Loop
  94.     Else
  95.         MsgBox "I was not able to find any unique 簽證內容.", vbCritical + vbOKOnly
  96.         Exit Sub
  97.     End If
  98. End Sub

  99. Private Sub Confirm_Click()
  100.     Dim tblName As String, fld As String
  101.     Dim nCode As Range
  102.    
  103.     If CallID.Text = "" Then RecordExisted.Caption = "": Exit Sub
  104.    
  105.     RecordExisted.Caption = ""
  106.     DateTime.Value = ""
  107.     DataCear

  108.     DateTime.Enabled = True
  109.         
  110.     UpdateDropDowns
  111.         
  112.     If ExcelData.Value = False And SQLData.Value = False Then ExcelData.Value = True
  113.         
  114.     If ExcelData.Value = True Then      '  從 Sheets("data") 中擷取資料
  115.         tblName = "[data$]"
  116.         fld = "[名字]"

  117.         Set nCode = Sheets("data").[B:B].Find(CallID.Text, , , 1)
  118.         If Not nCode Is Nothing Then
  119.             editMode = True
  120.             RecordExisted.ForeColor = &HFF0000
  121.             RecordExisted.Caption = "更新目前資料"
  122.             DeleteData.Visible = True
  123.                
  124.             With nCode
  125.                 DeptNo.Text = .Offset(, -1)
  126.                 DateTime.Text = .Offset(, 1)
  127.                 CreditDate.Text = .Offset(, 2)
  128.                 routinefrom.Text = .Offset(, 3)
  129.                 routineto.Text = .Offset(, 4)
  130.                 contents.Text = .Offset(, 5)
  131.                 cabin.Text = .Offset(, 6)
  132.                 License1.Text = .Offset(, 7)
  133.                 LicenseFee1.Text = .Offset(, 8)
  134.                 License2.Text = .Offset(, 9)
  135.                 LicenseFee2.Text = .Offset(, 10)
  136.                 ticketfee.Text = .Offset(, 11)
  137.                 totalfee.Text = .Offset(, 12)
  138.                 remarks.Text = .Offset(, 13)
  139.             End With
  140.         Else
  141.             editMode = False
  142.             RecordExisted.ForeColor = 255
  143.             RecordExisted.Caption = "新增一筆資料"
  144.             DeleteData.Visible = False
  145.             '  DateTime.Enabled = True
  146.             DateTime.Text = Now()
  147.         End If
  148.     Else                               '  從 Access 機票紀錄 中擷取資料
  149.         tblName = "機票紀錄"
  150.         fld = "名字"
  151.    
  152.         '  Populate data
  153.         strSQL = "SELECT * FROM " & tblName & " WHERE " & fld & " = '" & CallID.Text & "'"
  154.             
  155.         '  Now extract data
  156.         closeRS
  157.         OpenDB
  158.                
  159.         rs.Open strSQL, cnn, 1, 3     '  adOpenKeyset, adLockOptimistic
  160.         '  rs.Open strSQL, cnn, adOpenDynamic, adLockOptimistic
  161.         '  rs.Open strSQL, cnn, , adOpenDynamic
  162.         
  163.         If rs.RecordCount > 0 Then
  164.             editMode = True
  165.             RecordExisted.ForeColor = &HFF0000
  166.             RecordExisted.Caption = "更新目前資料"
  167.             DeleteData.Visible = True
  168.                
  169.             '  將搜尋到隻資料寫入各相關欄位內 (0 To rs.Fields.Count - 1)
  170.             With rs
  171.                 DeptNo.Value = .Fields(0).Value
  172.                 DateTime.Value = .Fields(2).Value
  173.                 CreditDate.Value = .Fields(3).Value
  174.                 routinefrom.Value = .Fields(4).Value
  175.                 routineto.Value = .Fields(5).Value
  176.                 contents.Value = .Fields(6).Value
  177.                 cabin.Value = .Fields(7).Value
  178.                 License1.Value = .Fields(8).Value
  179.                 LicenseFee1.Value = .Fields(9).Value
  180.                 License2.Value = .Fields(10).Value
  181.                 LicenseFee2.Value = .Fields(11).Value
  182.                 ticketfee.Value = .Fields(12).Value
  183.                 totalfee.Value = .Fields(13).Value
  184.                 remarks.Value = .Fields(14).Value
  185.             End With
  186.         Else
  187.             editMode = False
  188.             RecordExisted.ForeColor = 255
  189.             RecordExisted.Caption = "新增一筆資料"
  190.             DeleteData.Visible = False
  191.             '  DateTime.Enabled = True
  192.             DateTime.Text = Now()
  193.         End If
  194.     End If
  195.     Confirm.Enabled = False
  196.     SaveData.Enabled = True
  197.     ResetData.Enabled = True
  198.     DateTime.Enabled = False
  199. End Sub
複製代碼

TOP

回復 5# c_c_lai
  1. Private Sub DeleteData_Click()
  2.     Dim nCode As Range, ret As Boolean
  3.    
  4.     With Sheets("data")
  5.         Set nCode = .[B:B].Find(CallID.Text, , , 1)
  6.         .Rows(Val(Mid(nCode.Address, 4))).EntireRow.Delete Shift:=xlUp
  7.     End With
  8.    
  9.     ret = ExcelData.Value
  10.     ExcelData.Value = False
  11.    
  12.     closeRS
  13.     OpenDB
  14.    
  15.     strSQL = "DELETE FROM 機票紀錄 WHERE 名字 = '" & CallID.Text & "'"
  16.     cmd.CommandText = strSQL
  17.    
  18.     cmd.ActiveConnection = cnn
  19.     cmd.Execute
  20.     cnn.Close
  21.    
  22.     Confirm.Enabled = True
  23.     ExcelData.Value = ret
  24.     ResetData_Click
  25. End Sub

  26. Sub ResetData_Click()
  27.     CallID.Text = ""
  28.     RecordExisted.Caption = ""
  29.     Confirm.Enabled = True
  30.     DataCear
  31. End Sub

  32. Private Sub DataCear()
  33.     DeptNo.Text = ""
  34.     DateTime.Text = ""
  35.     CreditDate.Text = ""
  36.     License1.Text = ""
  37.     LicenseFee1.Text = "0"
  38.     License2.Text = ""
  39.     LicenseFee2.Text = "0"
  40.     cabin.Text = ""
  41.     ticketfee.Text = "0"
  42.     totalfee.Text = "0"
  43.     routinefrom.Text = ""
  44.     routineto.Text = ""
  45.     contents.Text = ""
  46.     remarks.Text = ""
  47. End Sub

  48. Private Sub SaveData_Click()
  49.     Dim totalRows As Long, ret As Boolean
  50.     Dim nCode As Range
  51.    
  52.     ret = ExcelData.Value
  53.     ExcelData.Value = True
  54.             
  55.     With Sheets("data")
  56.         '  寫入 Sheets("data")
  57.         If editMode = True Then
  58.             Set nCode = Sheets("data").[B:B].Find(CallID.Text, , , 1)
  59.             
  60.             With nCode
  61.                 .Offset(, -1) = DeptNo.Text
  62.                 .Offset(, 2) = CreditDate.Text
  63.                 .Offset(, 3) = routinefrom.Text
  64.                 .Offset(, 4) = routineto.Text
  65.                 .Offset(, 5) = contents.Text
  66.                 .Offset(, 6) = cabin.Text
  67.                 .Offset(, 7) = License1.Text
  68.                 .Offset(, 8) = LicenseFee1.Text
  69.                 .Offset(, 9) = License2.Text
  70.                 .Offset(, 10) = LicenseFee2.Text
  71.                 .Offset(, 11) = ticketfee.Text
  72.                 .Offset(, 12) = totalfee.Text
  73.                 .Offset(, 13) = remarks.Text
  74.             End With
  75.         Else
  76.             With Sheets("data")
  77.                 strSQL = "SELECT * FROM [data$] WHERE [名字] ='" & CallID.Text & "'"
  78.             
  79.                 '  Now extract data
  80.                 closeRS
  81.                 OpenDB
  82.                
  83.                 rs.Open strSQL, cnn, 1, 3     '  adOpenKeyset, adLockOptimistic
  84.                
  85.                 If rs.RecordCount = 0 Then  ' 先判斷資料是否已經存在,如果不存在,則 ...
  86.                     Set nCode = .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1)
  87.                     
  88.                     With nCode
  89.                         .Offset(, 0) = CallID.Text
  90.                         .Offset(, -1) = DeptNo.Text
  91.                         .Offset(, 1).NumberFormat = "m/d/yyyy hh:mm:ss"
  92.                         .Offset(, 1) = Format(DateTime.Text, "m/d/yyyy hh:mm:ss")
  93.                         .Offset(, 2) = CreditDate.Text
  94.                         .Offset(, 3) = routinefrom.Text
  95.                         .Offset(, 4) = routineto.Text
  96.                         .Offset(, 5) = contents.Text
  97.                         .Offset(, 6) = cabin.Text
  98.                         .Offset(, 7) = License1.Text
  99.                         .Offset(, 8) = LicenseFee1.Text
  100.                         .Offset(, 9) = License2.Text
  101.                         .Offset(, 10) = LicenseFee2.Text
  102.                         .Offset(, 11) = ticketfee.Text
  103.                         .Offset(, 12) = totalfee.Text
  104.                         .Offset(, 13) = remarks.Text
  105.                     End With
  106.                 End If
  107.             End With
  108.         End If
  109.         
  110.         ExcelData.Value = False
  111.         '  Now extract data
  112.         closeRS
  113.         OpenDB
  114.             
  115.         '  寫入 Access 資料庫
  116.         If editMode = True Then
  117.             strSQL = "Update 機票紀錄 SET 名字 = '" & CallID.Text & "', 單位 = '" & DeptNo.Text & _
  118.                      "', 刷卡日期 = '" & CreditDate.Text & "', 行程日期從 = '" & routinefrom.Text & _
  119.                      "', 行程日期到 = '" & routineto.Text & "', 行程內容 = '" & contents.Text & _
  120.                      "', 艙等 = '" & cabin.Text & "', 簽證內容1 = '" & License1.Text & "', 簽證費用1 = " & _
  121.                      LicenseFee1.Text & ", 簽證內容2 = '" & License2.Text & "', 簽證費用2 = " & LicenseFee2.Text & _
  122.                      ", 機票費用 = " & ticketfee.Text & ", 總計 = " & totalfee.Text & ", 備註 = '" & _
  123.                      remarks.Text & "' WHERE 名字 = '" & CallID.Text & "';"
  124.         Else
  125.             strSQL = "INSERT INTO 機票紀錄 (單位,名字,日期,刷卡日期,行程日期從,行程日期到,行程內容," & _
  126.                      "艙等,簽證內容1,簽證費用1,簽證內容2,簽證費用2,機票費用,總計,備註) VALUES ('" & DeptNo.Text & "','" & _
  127.                      CallID.Text & "','" & DateTime.Text & "','" & CreditDate.Text & "','" & routinefrom.Text & "','" & _
  128.                      routineto.Text & "','" & contents.Text & "','" & cabin.Text & "','" & License1.Text & "'," _
  129.                      & LicenseFee1.Text & ",'" & License2.Text & "'," & LicenseFee2.Text & "," & ticketfee.Text & "," & _
  130.                      totalfee.Text & ",'" & remarks.Text & "') ;"
  131.         End If
  132.         '  Sheets("data").[A20] = strSQL     '  檢查 strSQL 語法內容是否正確
  133.         cmd.CommandText = strSQL
  134.    
  135.         cmd.ActiveConnection = cnn
  136.         cmd.Execute
  137.         cnn.Close
  138.         
  139.         Confirm.Enabled = True
  140.         SaveData.Enabled = False
  141.         ResetData.Enabled = False
  142.         ExcelData.Value = ret
  143.         ResetData_Click
  144.     End With
  145. End Sub
複製代碼

TOP

將data放在Access,為何不直接在Access完成?

TOP

將data放在Access,為何不直接在Access完成?
aa7551 發表於 2013-12-9 18:34

我之所以要同時處裡 Excel 工作表單與 Access 資料庫的道理是希望
竊由此範例去讓人了解、應用、透過 ADO 如何去處理工作表單與
Access 資料庫的實作。
這原本是一位網友的提問,想透過這個議題讓她了解兩造的處理方式,
並同時能去理解如何處理雙工的作業。

TOP

回復 1# c_c_lai
accdb 中,表單名稱變了所以查不到,
機票記錄<>機票紀錄。

TOP

回復 9# stillfish00
太感謝你了!我原本一直在找原因(百思不解),
但千想萬想就是沒注意到一字之差 (紀 -> 記),
再次言謝,本程式終於能於 Office 2003、
Office 2007、2010 順利地自如作業了。

TOP

        靜思自在 : 有時當思無時苦,好天要積雨來糧。
返回列表 上一主題