|
|
老师们好，用ExcelVBA实现了单机版的ACCESS驱动和操作，请问，如果将ACCESS只作为一个数据库放在后台，多人用EXCEL中的VBA代码同时驱动ACCESS进行编辑，能否实现呢？如果能，代码该怎么写呢？
一台机器本地版本我用的以下代码，如果实现多人编辑，怎么连数据库，拜托指导，谢谢
Dim mybook, mypath, mysht, l, ll, i, ii, ITM, kigyou
Dim myCat As New ADOX.Catalog
Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim myData As String
Dim myTable As String
Dim SQL As String
mybook = ThisWorkbook.Name
mypath = ThisWorkbook.Path
mysht = ActiveSheet.Name
kigyoumei = "DB" '''■■■路径名 需要修改
documei = "BA_Analysis" '''■■■数据库名 需要修改
Tabmei1 = "Analysis" '''■■■数据表名 需要修改
Main_Picture.MultiPage1.Value = 1
Main_Picture.ListView2.ListItems.Clear
Main_Picture.ListView2.ColumnHeaders.Clear
If Dir(mypath & "\" & kigyoumei, vbDirectory) = "" Then
MkDir (mypath & "\" & kigyoumei)
End If
If Dir(mypath & "\" & kigyoumei & "\" & documei & ".accdb") = "" Then
MsgBox "DB not found", 16, "Error"
Else
''''''''↓↓↓↓↓↓建立数据库文件↓↓↓↓↓↓''''''''
Set myCat = CreateObject("ADOX.Catalog")
Set cnn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
'''''''''↓↓↓↓↓↓确认数据库是否存在↓↓↓↓↓↓'''''''''
myData = mypath & "\" & kigyoumei & "\" & documei & ".accdb" '设置login数据库名称（包括完整路径）
'If Dir(myData) = "" Then
'MsgBox myData & Chr(13) & " 数据库不存在，请先建立数据库后重试！", 16, "错误"
'Exit Sub
'End If
'''''''''↑↑↑↑↑↑确认数据库是否存在↑↑↑↑↑↑'''''''''
'''''''''↓↓↓↓↓↓连接数据库↓↓↓↓↓↓'''''''''
cnn = "Provider=Microsoft.Ace.OLEDB.12.0;" & "Data Source=" & myData '建立与建数据库的连接字符串
cnn.Open "provider=Microsoft.ACE.OLEDB.12.0" & ";Data Source =" & myData & ";Persist Security Info=False;Jet OLEDB:Database Password=123"
'''''初始化表头
With Main_Picture.ListView2
.View = lvwReport
.Gridlines = True
.CheckBoxes = False
.FullRowSelect = True
.ColumnHeaders.Add , , "No.", 50, lvwColumnLeft
.ColumnHeaders.Add , , "num", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Priority", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Task_Type", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Actual_start", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Actual_end", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Additional_comments", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Approval", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Assignment_group", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Business_duration", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Closed", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Closed_by", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Comments_and_Work_notes", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Company", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Configuration_item", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Created", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Created_by", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Description", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Do_main", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Effective_number", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Escalation", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Impact", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Opened", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Opened_by", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Parent", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Ser_vice", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Service_offering", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Up_dated", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Up_dated_by", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Reassignment_count", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Up_dates", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Up_on_approval", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Up_on_reject", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Urgency", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Work_notes", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Activity_due", 50, lvwColumnLeft
.ColumnHeaders.Add , , "State", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Assigned_to", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Short_description", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Task_Type_input", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Category", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Sub_Category", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Responsible", 50, lvwColumnLeft
.ColumnHeaders.Add , , "Resolution_time", 50, lvwColumnLeft
.ColumnHeaders.Add , , "No_of_Week", 50, lvwColumnLeft
SQL = "Select * From " & Tabmei1
rs.Open SQL, cnn
Do While Not rs.EOF
Set ITM = .ListItems.Add()
ITM.Text = ""
ITM.SubItems(1) = IIf(IsNull(rs("num")), "", rs("num")) '渚涘?
ITM.SubItems(2) = IIf(IsNull(rs("Priority")), "", rs("Priority")) '渚涘?
ITM.SubItems(3) = IIf(IsNull(rs("Task_Type")), "", rs("Task_Type")) '渚涘?
ITM.SubItems(4) = IIf(IsNull(rs("Actual_start")), "", rs("Actual_start")) '渚涘?
ITM.SubItems(5) = IIf(IsNull(rs("Actual_end")), "", rs("Actual_end")) '渚涘?
ITM.SubItems(6) = IIf(IsNull(rs("Additional_comments")), "", rs("Additional_comments")) '渚涘?
ITM.SubItems(7) = IIf(IsNull(rs("Approval")), "", rs("Approval")) '渚涘?
ITM.SubItems(8) = IIf(IsNull(rs("Assignment_group")), "", rs("Assignment_group")) '渚涘?
ITM.SubItems(9) = IIf(IsNull(rs("Business_duration")), "", rs("Business_duration")) '渚涘?
ITM.SubItems(10) = IIf(IsNull(rs("Closed")), "", rs("Closed")) '渚涘?
ITM.SubItems(11) = IIf(IsNull(rs("Closed_by")), "", rs("Closed_by")) '渚涘?
ITM.SubItems(12) = IIf(IsNull(rs("Comments_and_Work_notes")), "", rs("Comments_and_Work_notes")) '渚涘?
ITM.SubItems(13) = IIf(IsNull(rs("Company")), "", rs("Company")) '渚涘?
ITM.SubItems(14) = IIf(IsNull(rs("Configuration_item")), "", rs("Configuration_item")) '渚涘?
ITM.SubItems(15) = IIf(IsNull(rs("Created")), "", rs("Created")) '渚涘?
ITM.SubItems(16) = IIf(IsNull(rs("Created_by")), "", rs("Created_by")) '渚涘?
ITM.SubItems(17) = IIf(IsNull(rs("Description")), "", rs("Description")) '渚涘?
ITM.SubItems(18) = IIf(IsNull(rs("Do_main")), "", rs("Do_main")) '渚涘?
ITM.SubItems(19) = IIf(IsNull(rs("Effective_number")), "", rs("Effective_number")) '渚涘?
ITM.SubItems(20) = IIf(IsNull(rs("Escalation")), "", rs("Escalation")) '渚涘?
ITM.SubItems(21) = IIf(IsNull(rs("Impact")), "", rs("Impact")) '渚涘?
ITM.SubItems(22) = IIf(IsNull(rs("Opened")), "", rs("Opened")) '渚涘?
ITM.SubItems(23) = IIf(IsNull(rs("Opened_by")), "", rs("Opened_by")) '渚涘?
ITM.SubItems(24) = IIf(IsNull(rs("Parent")), "", rs("Parent")) '渚涘?
ITM.SubItems(25) = IIf(IsNull(rs("Ser_vice")), "", rs("Ser_vice")) '渚涘?
ITM.SubItems(26) = IIf(IsNull(rs("Service_offering")), "", rs("Service_offering")) '渚涘?
ITM.SubItems(27) = IIf(IsNull(rs("Up_dated")), "", rs("Up_dated")) '渚涘?
ITM.SubItems(28) = IIf(IsNull(rs("Up_dated_by")), "", rs("Up_dated_by")) '渚涘?
ITM.SubItems(29) = IIf(IsNull(rs("Reassignment_count")), "", rs("Reassignment_count")) '渚涘?
ITM.SubItems(30) = IIf(IsNull(rs("Up_dates")), "", rs("Up_dates")) '渚涘?
ITM.SubItems(31) = IIf(IsNull(rs("Up_on_approval")), "", rs("Up_on_approval")) '渚涘?
ITM.SubItems(32) = IIf(IsNull(rs("Up_on_reject")), "", rs("Up_on_reject")) '渚涘?
ITM.SubItems(33) = IIf(IsNull(rs("Urgency")), "", rs("Urgency")) '渚涘?
ITM.SubItems(34) = IIf(IsNull(rs("Work_notes")), "", rs("Work_notes")) '渚涘?
ITM.SubItems(35) = IIf(IsNull(rs("Activity_due")), "", rs("Activity_due")) '渚涘?
ITM.SubItems(36) = IIf(IsNull(rs("State")), "", rs("State")) '渚涘?
ITM.SubItems(37) = IIf(IsNull(rs("Assigned_to")), "", rs("Assigned_to")) '渚涘?
ITM.SubItems(38) = IIf(IsNull(rs("Short_description")), "", rs("Short_description")) '渚涘?
ITM.SubItems(39) = IIf(IsNull(rs("Task_Type_input")), "", rs("Task_Type_input")) '渚涘?
ITM.SubItems(40) = IIf(IsNull(rs("Category")), "", rs("Category")) '渚涘?
ITM.SubItems(41) = IIf(IsNull(rs("Sub_Category")), "", rs("Sub_Category")) '渚涘?
ITM.SubItems(42) = IIf(IsNull(rs("Responsible")), "", rs("Responsible")) '渚涘?
ITM.SubItems(43) = IIf(IsNull(rs("Resolution_time")), "", rs("Resolution_time")) '渚涘?
ITM.SubItems(44) = IIf(IsNull(rs("No_of_Week")), "", rs("No_of_Week")) '渚涘?
rs.MoveNext
Loop
End With
cnn.Close '关闭连接
Set cnn = Nothing
End If
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-4-28 14:40
