这是一张进货表,采用一键导入数据库方式。
Private Sub CommandButton1_Click()
'从数据库读取供应商名称,写入名称管理器的供应商名称
'从数据库读取客户代号,写入名称管理器的客户代号
Dim rsT As New ADODB.Recordset
Dim Conn As ADODB.Connection
Dim myData As String
'Dim Arr As Object
'连接数据库
myData = ThisWorkbook.Path & "\acjxc.accdb"
Set Conn = CreateObject("ADODB.Connection") '这属于后期绑定
Conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myData
Conn.ConnectionString = Conn.ConnectionString & ";Jet OLEDB:Database Password = gpflovezx@1980"
Conn.Open
'读取供应商清单
sqL = "SELECT 供应商名称 FROM GYSQD "
rsT.Open sqL, Conn, adOpenKeyset, adLockOptimistic
If rsT.RecordCount = 0 Then
MsgBox ("供应商清单为空!!!")
rsT.Close
Exit Sub
Else
Arr = rsT.GetRows
End If
rsT.Close
'输出导入结果
Range(Cells(3, 27), Cells(1000, 27)).ClearContents
For i = 0 To UBound(Arr, 2)
Cells(3 + i, 27) = Arr(0, i)
Next i
With ActiveWorkbook.Names("供应商名称")
.Name = "供应商名称"
.RefersToR1C1 = "=进!R3C27:R" & 3 + i & "C27"
.Comment = ""
End With
'读取货号
sqL = "SELECT 货号 FROM CPQD "
rsT.Open sqL, Conn, adOpenKeyset, adLockOptimistic
If rsT.RecordCount = 0 Then
MsgBox ("产品清单为空!!!")
rsT.Close
Exit Sub
Else
Arr = rsT.GetRows
End If
rsT.Close
'输出导入结果
Range(Cells(3, 28), Cells(1000, 28)).ClearContents
For i = 0 To UBound(Arr, 2)
Cells(3 + i, 28) = Arr(0, i)
Next i
With ActiveWorkbook.Names("货号")
.Name = "货号"
.RefersToR1C1 = "=进!R3C28:R" & 3 + i & "C28"
.Comment = ""
End With
'读取客户代号
sqL = "SELECT 客户代号 FROM KHQD "
rsT.Open sqL, Conn, adOpenKeyset, adLockOptimistic
If rsT.RecordCount = 0 Then
MsgBox ("客户清单为空!!!")
rsT.Close
Exit Sub
Else
Arr = rsT.GetRows
End If
rsT.Close
'输出导入结果
Range(Cells(3, 29), Cells(1000, 29)).ClearContents
For i = 0 To UBound(Arr, 2)
Cells(3 + i, 29) = Arr(0, i)
Next i
With ActiveWorkbook.Names("客户代号")
.Name = "货号"
.RefersToR1C1 = "=进!R3C29:R" & 3 + i & "C29"
.Comment = ""
End With
End Sub
这是导入数据库的代码
通过 excel+access+vba 实现小企业的进销存管理系统