|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 samuel-he 于 2012-10-7 20:07 编辑
各位老师:请教一个加密的问题:
说明1:
1.我的本机电脑名称:wally
2.在我的本机共享一个资料夹名称:palan
3.palan 内存放了一个数据库:名称:standard
4.我给standard 加了一个密码:123456
说明2:
1.用EXCEL VB修改数据库的资料(以识别码为准,如果有识别码为修改原有资料,没有则新增加)
2.现在代码在standard没有加密码的情况下可以进行新增修改:
问题:
在standard有加密情况下进行修改(以识别码为准,如果有识别码为修改原有资料,没有则新增加)
请问这个代码怎样修改??
原代码(请在原代码上进行修改)
Private Sub CommandButton1_Click()
'2.新增产品标准资料到数据库standard 的工作表 Product
Dim product As String, myTable As String
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Long, j As Long
Dim myCat As New ADOX.Catalog
Dim myCmd As ADODB.Command
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Set wb = ThisWorkbook
Set ws = wb.Sheets("产品标准") '当前EXCEL工作表名称
product = "\\WALLY\palan\standard.MDB" '数据库名称 standard
myTable = "Product" '数据库工作表名称
If Dir(product) = "" Then
myCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & product
Set cnn = myCat.ActiveConnection
Set myCmd = New ADODB.Command
Set myCmd.ActiveConnection = cnn
myCmd.CommandText = "CREATE TABLE " & product _
& "(编码 Text(150),拉别 text(150),客户 text(150)内部料号 text(150),客户料号 text(150),部品 text(150),规格 text(150),用量 Single,准备工时 Single,标准工时 Single,10H产能 Single)," _
& "(备注1 text(150),备注2 text(150),时间 date(150),电脑 text(150),用户 text(150)),"
myCmd.Execute , , adCmdText
Else
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open product
End With
Set rs = cnn.OpenSchema(adSchemaTables)
Do Until rs.EOF
If LCase(rs!table_name) = LCase(myTable) Then GoTo hhh
rs.MoveNext
Loop
Set myCmd = New ADODB.Command
Set myCmd.ActiveConnection = cnn
myCmd.CommandText = "CREATE TABLE " & product _
& "(编码 Text(150),拉别 text(150),客户 text(150)内部料号 text(150),客户料号 text(150),部品 text(150),规格 text(150),用量 Single,准备工时 Single,标准工时 Single,10H产能 Single)," _
& "(备注1 text(150),备注2 text(150),时间 date(150),电脑 text(150),用户 text(150)),"
myCmd.Execute , , adCmdText
hhh:
End If
n = ws.Range("A65536").End(xlUp).Row
For i = 3 To n '第3行开始
If ws.Cells(i, 17).Value <> "" Then
SQL = "select * from product where 识别码=" & ws.Cells(i, 17).Value
Else
SQL = "select * from product"
End If
Set rs = New ADODB.Recordset
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount = 0 Or ws.Cells(i, 17).Value = "" Then
rs.AddNew
For j = 1 To rs.Fields.Count - 1
rs.Fields(j - 1) = ws.Cells(i, j).Value
Next j
rs.Update
Else
For j = 1 To rs.Fields.Count - 1
rs.Fields(j - 1) = ws.Cells(i, j).Value
Next j
rs.Update
End If
Next i
MsgBox "^-^ 存储成功! ^-^", vbInformation, "系统提示! "
rs.Close
cnn.Close
Set wb = Nothing
Set ws = Nothing
Set rs = Nothing
Set myCmd = Nothing
Set myCat = Nothing
Set cnn = Nothing
End If
End Sub
|
|