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

c_c_lai

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

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.  這是一篇我個人認為蠻能玩味的程式撰寫，希望大家共襄盛舉。

下載 (58.28 KB)

2013-12-8 19:44

下載 (63.72 KB)

2013-12-8 19:44

c_c_lai

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

下載次數: 46

2013-12-8 19:46

c_c_lai

回復 2# c_c_lai
Acess 資料庫：
機票記錄明細表.mdb
機票記錄明細表檔案.accdb  (For 2010)
2014年機票記錄db.rar (29.21 KB)

下載次數: 40

2013-12-8 19:48

尚請各位大大鼎力協助解決，謝謝大家！

c_c_lai

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

1. '  [ThisWorkbook]
   
2. Option Explicit
   
3. 
   
4. Private Sub Workbook_Open()
   
5.     With Sheets("機票作業")
   
6.         .ExcelData.Value = True
   
7.         .SQLData.Value = False
   
8.         .CallID.Value = ""
   
9.         .DateTime.Value = ""
   
10.         .RecordExisted.Caption = ""
    
11.         .Activate
    
12.         .SaveData.Enabled = False
    
13.         .ResetData.Enabled = False
    
14.         .ResetData_Click
    
15.     End With
    
16. End Sub

複製代碼

c_c_lai

回復 4# c_c_lai

1. '  [Sheet1 (機票作業)]
   
2. Option Explicit
   
3. Option Base 1
   
4. 
   
5. Dim cnn As Object      '  New ADODB.Connection
   
6. Dim cmd As Object      '  New ADODB.Command
   
7. Dim rs As Object       '  New ADODB.Recordset
   
8. Dim strSQL As String
   
9. Dim editMode As Boolean
   
10. Dim State, CursorLocation
    
11. 
    
12. Sub OpenDB()
    
13.     If ExcelData.Value = True Then    '  [data$]
    
14.         Set cnn = CreateObject("ADODB.Connection")
    
15.         Set rs = CreateObject("ADODB.Recordset")
    
16.         Set cmd = CreateObject("ADODB.Command")
    
17.     Else                              '  機票紀錄
    
18.         Set cnn = New ADODB.Connection
    
19.         Set rs = New ADODB.Recordset
    
20.         Set cmd = New ADODB.Command
    
21.     End If
    
22.     '  ObjectStateEnum Values
    
23.     '  Returns a value describing if the connection is open or closed
    
24.     '  Specifies whether an object is open or closed, connecting to a data source,
    
25.     '  executing a command, or retrieving data.
    
26.     '  --------------------------------------------------------------------------
    
27.     '  Constant             Value     Description
    
28.     '  --------------------------------------------------------------------------
    
29.     '  adStateClosed          0       The object is closed
    
30.     '  adStateOpen            1       The object is open
    
31.     '  adStateConnecting      2       The object is connecting
    
32.     '  adStateExecuting       4       The object is executing a command
    
33.     '  adStateFetching        8       The rows of the object are being retrieved
    
34.     With cnn
    
35.         If .State = 1 Then .Close    '  adStateOpen
    
36.         
    
37.         If ExcelData.Value = True Then
    
38.             .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
    
39.                                 ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
    
40.         Else
    
41.             .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & _
    
42.                               ThisWorkbook.Path & Application.PathSeparator & "機票記錄明細表.mdb" & ";"
    
43.             '  For Microsoft.ACE.OLEDB.12.0,you need Microsoft Office 12.0 Access Database Engine to be installed.
    
44.             '  .ConnectionString = "Provider=Microsoft.Ace.OLEDB.12.0;" & "Data Source=" & _
    
45.             '                    ThisWorkbook.Path & Application.PathSeparator & "機票記錄明細表檔案.accdb" & ";"
    
46.         End If
    
47.         .Open
    
48.     End With
    
49. End Sub
    
50. 
    
51. Sub closeRS()
    
52.     With rs
    
53.         If ExcelData.Value = False Then
    
54.             If .State = 1 Then .Close    '  adStateOpen
    
55.             '  The CursorLocation property is used to set or return the location of the cursor.
    
56.             '  This property can be set to one of the CursorLocationEnum constants listed in the following table.
    
57.             '  Enumeratio0n     Value   Description
    
58.             '  adUseNone          1     This value indicates no cursor location.
    
59.             '                           This value is not supported by the MicrosoftR OLE DB Provider for AS/400 and VSAM.
    
60.             '  adUseServer        2     This value indicates that the data provider or driver-supplied cursor is used.
    
61.             '  adUseClient        3     This value indicates that a client-side cursor supplied by a local cursor library
    
62.             '                           is to be used.
    
63.             '  adUseClientBatch   3     For backward compatibility, this value indicates that a client-side cursor supplied by
    
64.             '                           a local cursor library is to be used.
    
65.             .CursorLocation = 3          '  adUseClient
    
66.         Else
    
67.             If State = 1 Then .Close    '  adStateOpen
    
68.             CursorLocation = 3          '  adUseClient
    
69.         End If
    
70.     End With
    
71. End Sub
    
72. 
    
73. Private Sub ExcelData_Click()
    
74.     '  MsgBox "Option is Excel Data "
    
75. End Sub
    
76. 
    
77. Private Sub SQLData_Click()
    
78.     '  MsgBox "Option is SQL Data "
    
79. End Sub
    
80. 
    
81. Private Sub UpdateDropDowns()
    
82.     If ExcelData.Value = True Then
    
83.         strSQL = "Select Distinct [簽證內容] From [簽證項目$] Order by [簽證內容]"
    
84.     Else
    
85.         strSQL = "Select Distinct 簽證內容 From 簽證項目 Order by 簽證內容"
    
86.     End If
    
87.    
    
88.     '  closeRS
    
89.     OpenDB
    
90.     License1.Clear
    
91.     License2.Clear
    
92.    
    
93.     rs.Open strSQL, cnn, 1, 3     '  adOpenKeyset, adLockOptimistic
    
94.     If rs.RecordCount > 0 Then
    
95.         Do While Not rs.EOF
    
96.             License1.AddItem rs.Fields(0)    '  Select Distinct [簽證內容] From
    
97.             License2.AddItem rs.Fields(0)    '  Select Distinct [簽證內容] From
    
98.             rs.MoveNext
    
99.         Loop
    
100.     Else
     
101.         MsgBox "I was not able to find any unique 簽證內容.", vbCritical + vbOKOnly
     
102.         Exit Sub
     
103.     End If
     
104. End Sub
     
105. 
     
106. Private Sub Confirm_Click()
     
107.     Dim tblName As String, fld As String
     
108.     Dim nCode As Range
     
109.    
     
110.     If CallID.Text = "" Then RecordExisted.Caption = "": Exit Sub
     
111.    
     
112.     RecordExisted.Caption = ""
     
113.     DateTime.Value = ""
     
114.     DataCear
     
115. 
     
116.     DateTime.Enabled = True
     
117.         
     
118.     UpdateDropDowns
     
119.         
     
120.     If ExcelData.Value = False And SQLData.Value = False Then ExcelData.Value = True
     
121.         
     
122.     If ExcelData.Value = True Then      '  從 Sheets("data") 中擷取資料
     
123.         tblName = "[data$]"
     
124.         fld = "[名字]"
     
125. 
     
126.         Set nCode = Sheets("data").[B:B].Find(CallID.Text, , , 1)
     
127.         If Not nCode Is Nothing Then
     
128.             editMode = True
     
129.             RecordExisted.ForeColor = &HFF0000
     
130.             RecordExisted.Caption = "更新目前資料"
     
131.             DeleteData.Visible = True
     
132.                
     
133.             With nCode
     
134.                 DeptNo.Text = .Offset(, -1)
     
135.                 DateTime.Text = .Offset(, 1)
     
136.                 CreditDate.Text = .Offset(, 2)
     
137.                 routinefrom.Text = .Offset(, 3)
     
138.                 routineto.Text = .Offset(, 4)
     
139.                 contents.Text = .Offset(, 5)
     
140.                 cabin.Text = .Offset(, 6)
     
141.                 License1.Text = .Offset(, 7)
     
142.                 LicenseFee1.Text = .Offset(, 8)
     
143.                 License2.Text = .Offset(, 9)
     
144.                 LicenseFee2.Text = .Offset(, 10)
     
145.                 ticketfee.Text = .Offset(, 11)
     
146.                 totalfee.Text = .Offset(, 12)
     
147.                 remarks.Text = .Offset(, 13)
     
148.             End With
     
149.         Else
     
150.             editMode = False
     
151.             RecordExisted.ForeColor = 255
     
152.             RecordExisted.Caption = "新增一筆資料"
     
153.             DeleteData.Visible = False
     
154.             '  DateTime.Enabled = True
     
155.             DateTime.Text = Now()
     
156.         End If
     
157.     Else                               '  從 Access 機票紀錄 中擷取資料
     
158.         tblName = "機票紀錄"
     
159.         fld = "名字"
     
160.    
     
161.         '  Populate data
     
162.         strSQL = "SELECT * FROM " & tblName & " WHERE " & fld & " = '" & CallID.Text & "'"
     
163.             
     
164.         '  Now extract data
     
165.         closeRS
     
166.         OpenDB
     
167.                
     
168.         rs.Open strSQL, cnn, 1, 3     '  adOpenKeyset, adLockOptimistic
     
169.         '  rs.Open strSQL, cnn, adOpenDynamic, adLockOptimistic
     
170.         '  rs.Open strSQL, cnn, , adOpenDynamic
     
171.         
     
172.         If rs.RecordCount > 0 Then
     
173.             editMode = True
     
174.             RecordExisted.ForeColor = &HFF0000
     
175.             RecordExisted.Caption = "更新目前資料"
     
176.             DeleteData.Visible = True
     
177.                
     
178.             '  將搜尋到隻資料寫入各相關欄位內 (0 To rs.Fields.Count - 1)
     
179.             With rs
     
180.                 DeptNo.Value = .Fields(0).Value
     
181.                 DateTime.Value = .Fields(2).Value
     
182.                 CreditDate.Value = .Fields(3).Value
     
183.                 routinefrom.Value = .Fields(4).Value
     
184.                 routineto.Value = .Fields(5).Value
     
185.                 contents.Value = .Fields(6).Value
     
186.                 cabin.Value = .Fields(7).Value
     
187.                 License1.Value = .Fields(8).Value
     
188.                 LicenseFee1.Value = .Fields(9).Value
     
189.                 License2.Value = .Fields(10).Value
     
190.                 LicenseFee2.Value = .Fields(11).Value
     
191.                 ticketfee.Value = .Fields(12).Value
     
192.                 totalfee.Value = .Fields(13).Value
     
193.                 remarks.Value = .Fields(14).Value
     
194.             End With
     
195.         Else
     
196.             editMode = False
     
197.             RecordExisted.ForeColor = 255
     
198.             RecordExisted.Caption = "新增一筆資料"
     
199.             DeleteData.Visible = False
     
200.             '  DateTime.Enabled = True
     
201.             DateTime.Text = Now()
     
202.         End If
     
203.     End If
     
204.     Confirm.Enabled = False
     
205.     SaveData.Enabled = True
     
206.     ResetData.Enabled = True
     
207.     DateTime.Enabled = False
     
208. End Sub

複製代碼

c_c_lai

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

複製代碼

aa7551

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

c_c_lai

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

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

stillfish00

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

c_c_lai

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