注册 登录
编程论坛 → VB6论坛

【求助】实时错误3219 在此环境中不允许操作 请大侠指点啊

coucongzi 发布于 2014-03-05 10:43， 4483 次点击
请大侠帮忙看看有什么问题啊，我一直都找不出来。初学者
每次点击Command2插入图片到image空间后，点击保存，就会有错误提示“实时错误3219 在此环境中不允许操作”
调试错误是在“rs.Fields("图片") = str.Read”这代码，如果没有插入图片，是可以保存的
恳请大侠帮帮忙啊！！在线等

程序代码：

Dim str As New ADODB.Stream
Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
...
Private Sub Form_Load()
Conn.Provider = "Microsoft.Jet.OLEDB.4.0"
Conn.ConnectionString = "Data Source=" & App.Path & "\zxb.mdb" & " ;Jet OLEDB:Database password= coucongzi" ';Persist Security Info=False"
Conn.Open
rs.CursorLocation = adUseClient
rs.Open "select * from hzb", Conn, adOpenDynamic, adLockPessimistic
...
Private Sub save_Click()  '保存数据
str.Open
rs.AddNew
If CommonDialog1.FileName <> "" Then
Call ViewDatayt
Else
Call ViewDatamt
End If
rs.Update
Form1.Refresh
MsgBox "保存成功！", vbOKOnly, "温馨提示！"
str.Close
bj.Enabled = True
xz.Enabled = True
save.Enabled = False
End Sub
...
Private Sub ViewDatayt()     '定义赋值函数  载入数据库 有图片
str.LoadFromFile CommonDialog1.FileName '载入图片
rs.Fields("面部交期") = Text2(0).Text
rs.Fields("装饰交期") = Text2(1).Text
rs.Fields("底部交期") = Text2(2).Text
rs.Fields("包装交期") = Text2(3).Text
rs.Fields("材料") = Text2(4).Text
rs.Fields("补产材料") = Text2(5).Text
rs.Fields("原因分析") = Text2(6).Text
rs.Fields("外加工单位") = Text2(7).Text
rs.Fields("印刷单位") = Text2(8).Text
rs.Fields("备注") = Text2(9).Text
rs.Fields("备注一") = Text2(10).Text
rs.Fields("备注二") = Text2(11).Text
rs.Fields("备注三") = Text2(12).Text
rs.Fields("图片") = str.Read
rs.Fields("编号") = Text7.Text
End Sub
...
Private Sub Command2_Click()
On Error Resume Next
Kill (App.Path + "\test1.jpg")
CommonDialog1.DialogTitle = "加载图片"
CommonDialog1.Filter = "所有图片文件|*.jpg"
CommonDialog1.ShowOpen
Image1.Picture = LoadPicture(CommonDialog1.FileName)
End Sub


[ 本帖最后由 coucongzi 于 2014-3-5 11:49 编辑 ]
4 回复
#2
coucongzi2014-03-05 14:43
会不会是这段代码出了问题啊
哪位大侠指点一下小弟啊
rs.Open "select * from hzb", Conn, adOpenDynamic, adLockPessimistic
#3
coucongzi2014-03-05 14:43
会不会是这段代码出了问题啊
哪位大侠指点一下小弟啊
rs.Open "select * from hzb", Conn, adOpenDynamic, adLockPessimistic
#4
chen35232014-03-09 12:58
我曾经出现过的问题是：在没有输入备注时显示错误，但记不起提示什么内容，建议修改：
if text2(9).text<>"" then rs.Fields("备注") = Text2(9).Text   '前提条件是数据库设置时允许备注为空
如果存在不输入的字段都设置 if ...then 试试看

我使用打开数据库的方法与你的不同，下面是我全部的内容，可以试着修改使用。
Private Sub Form_Activate()
  Dim S As String
   S = App.Path & "\整治.mdb" '　  
  Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”  无密码数据库的打开语句为：";Persist Security Info=False" '打开数据库
    = adCmdTable
    Adodc1.RecordSource = "项目文件表"
    Adodc1.Refresh

  Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”
    = adCmdTable
    Adodc2.RecordSource = "人权表"
    Adodc2.Refresh

  Adodc3.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”

     SQL = "SELECT * FROM 项目表  order by 项目ID desc"
       = adCmdunknow               
      Adodc3.RecordSource = SQL
      Adodc3.Refresh
       Set DataCombo1.RowSource = Adodc3
       DataCombo1.ListField = "项目名称"     

  Adodc4.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”
    = adCmdTable
    Adodc4.RecordSource = "预算各项投资表"
    Adodc4.Refresh

  Adodc5.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”
    = adCmdTable
    Adodc5.RecordSource = "款项名称表"
    Adodc5.Refresh
  '   Set DataCombo2.RowSource = Adodc5
  '     DataCombo2.ListField = "款项"

  Adodc6.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”
    = adCmdTable
    Adodc6.RecordSource = "完成表"
    Adodc6.Refresh

  Adodc7.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”
    = adCmdTable
    Adodc7.RecordSource = "支付款表"
    Adodc7.Refresh

  Adodc8.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”
    = adCmdTable
    Adodc8.RecordSource = "合同单位价格表"
    Adodc8.Refresh
     
   
   Adodc9.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”
    = adCmdTable
    Adodc9.RecordSource = "归档盒名表"
    Adodc9.Refresh
    '   Set DataCombo4.RowSource = Adodc9
    '   DataCombo2.ListField = "资料名"      
   
    Adodc10.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" + Chr(34) + S + Chr(34) & ";Jet OLEDB:Database Password=ch23;"  '打开有密码数据库，密码为“ch23”
    = adCmdTable
    Adodc10.RecordSource = "项目文件表"
    Adodc10.Refresh
      
End Sub

Private Sub Form_Load()
   Form录入.Width = Screen.Width - 300
   Form录入.Height = Screen.Height * 0.9
   Form录入.Left = 0
   Form录入.Top = 0
  
   Adodc9.Visible = False
   Adodc2.Visible = False
   Adodc3.Visible = False
   Adodc4.Visible = False
   Adodc5.Visible = False
   Adodc6.Visible = False
   Adodc7.Visible = False
   Adodc8.Visible = False   
   Adodc1.Visible = False
   Adodc10.Visible = False
  
End Sub

Private Sub Command2_Click()   ‘ 确定记录

If Option1(0).Value = True Then
   If DataCombo1 = "" Then
      MsgBox "项目名称不能空，请重新选择！"
   Else
          Adodc1.Recordset.AddNew
             With Adodc1
               .Recordset("项目名称") = Trim$(DataCombo1.Text)
               .Recordset("文件名") = Trim$(Text1(0).Text)
               .Recordset("日期") = Trim$(Text1(1).Text)
               .Recordset("存档合号") = Trim$(Text1(2).Text)
               .Recordset("本合序号") = Trim$(Text1(3).Text)
               .Recordset("备注") = Trim$(Text1(4).Text)
               .Recordset.Update
            End With
      
   End If
ElseIf Option1(1).Value = True Then
   If Text1(2) = "" Then
      MsgBox "姓名不能空，请重新填写！"
   Else
       Adodc2.Recordset.AddNew
         With Adodc2
           .Recordset("姓名") = Trim$(Text1(2).Text)
           .Recordset("密码") = Trim$(Text1(3).Text)
           .Recordset("权限") = "输入"
           .Recordset.Update
        End With
   End If
ElseIf Option1(2).Value = True Then
   If Text1(0) = "" Then
      MsgBox "项目名称不能空，请重新填写！"
   Else
       Adodc3.Recordset.AddNew
         With Adodc3
           .Recordset("项目名称") = Trim$(Text1(0).Text)
           .Recordset.Update
        End With
   End If
ElseIf Option1(3).Value = True Then    ' 预算投资明细表
   If DataCombo1 = "" Then
      MsgBox "请选择项目名称！"
   Else
      Adodc4.Recordset.AddNew
         With Adodc4
           .Recordset("项目名称") = Trim$(DataCombo1.Text)
           .Recordset("工程施工费") = Trim$(Text5(0).Text)
           If Text5(1) <> "" Then .Recordset("设备费") = Trim$(Text5(1).Text)
           .Recordset("前期清查费") = Trim$(Text5(2).Text)
           .Recordset("前期可研费") = Trim$(Text5(3).Text)
           .Recordset("前期设计预算费") = Trim$(Text5(4).Text)
           .Recordset("前期勘测费") = Trim$(Text5(5).Text)
           .Recordset("前期招标代理费") = Trim$(Text5(6).Text)
           If Text5(7) <> "" Then .Recordset("前期重大工程规划费") = Trim$(Text5(7).Text)
           .Recordset("工程监理费") = Trim$(Text5(8).Text)
           If Text5(9) <> "" Then .Recordset("拆迁补偿费") = Trim$(Text5(9).Text)
           If Text5(10) <> "" Then .Recordset("竣工复核费") = Trim$(Text5(10).Text)
           .Recordset("竣工验收费") = Trim$(Text5(11).Text)
           .Recordset("竣工决算审计费") = Trim$(Text5(12).Text)
           .Recordset("竣工重估与登记费") = Trim$(Text5(13).Text)
           .Recordset("竣工农田补划与标志费") = Trim$(Text5(14).Text)
           .Recordset("业主管理费") = Trim$(Text5(15).Text)
           .Recordset("不可预见费") = Trim$(Text5(16).Text)
           .Recordset("本合序号") = Trim$(Text1(3).Text)
           .Recordset.Update
        End With
           Adodc1.Recordset.AddNew
             With Adodc1
               .Recordset("项目名称") = Trim$(DataCombo1.Text)
               .Recordset("文件名") = Trim$(Text1(0).Text)
               .Recordset("日期") = Trim$(Text1(1).Text)
               .Recordset("存档合号") = Trim$(Text1(2).Text)
               .Recordset("本合序号") = Trim$(Text1(3).Text)
               .Recordset("备注") = Trim$(Text1(4).Text)
               .Recordset.Update
            End With
   End If
ElseIf Option1(4).Value = True Then     '合同单位 价格
   Adodc8.Recordset.AddNew
        With Adodc8
           .Recordset("项目名称") = Trim$(DataCombo1.Text)
           .Recordset("款项名称") = Trim$(DataCombo2.Text)
           .Recordset("签订单位") = Trim$(Text1(0).Text)
           .Recordset("合同金额") = Trim$(Text1(5).Text)
           .Recordset("签订日期") = Trim$(Text1(1).Text)
           .Recordset("备注") = Trim$(Text1(4).Text)
           .Recordset("本合序号") = Trim$(Text1(3).Text)
           .Recordset.Update
        End With
        Adodc1.Recordset.AddNew
         With Adodc1
           .Recordset("项目名称") = Trim$(DataCombo1.Text)
           .Recordset("文件名") = "合同_" & Trim$(DataCombo2.Text) & "_" & Trim$(Text1(0).Text)
           .Recordset("日期") = Trim$(Text1(1).Text)
           .Recordset("存档合号") = Trim$(Text1(2).Text)
           .Recordset("本合序号") = Trim$(Text1(3).Text)
           .Recordset("备注") = Trim$(Text1(4).Text) & " 合同金额：" & Trim$(Text1(5).Text) & "元"
           .Recordset.Update
           
        End With

ElseIf Option1(5).Value = True Then   '支付款表
   If DataCombo1 = "" Then
      MsgBox "师出有名，哪个项目取款？请选择项目名称！"
   ElseIf DataCombo2 = "" Then
      MsgBox "给钱谁，要记录的呀！请选择付款类别！"
   Else
     
     
      If Text1(5) = "" Then   '完成任务存档
           msg2 = MsgBox("没有完成工作量？", 1, "完成工作量提示")
      Else
           msg2 = 1
      End If   '完成任务存档结束
     
     
      If Text1(6) = "" Then   '付款存档
           msg3 = MsgBox("没有付款？", 1, "付款提示")
      Else
           msg3 = 1
      End If   '付款存档结束
     
         If msg2 = 1 And msg3 = 1 Then
       Adodc1.Recordset.AddNew
         With Adodc1
           .Recordset("项目名称") = Trim$(DataCombo1.Text)
           .Recordset("文件名") = Trim$(DataCombo2.Text) & "_付款资料 " & Trim$(Text1(0).Text) & "_完成工作量:" & Text1(5).Text & "元，付款金额:" & Text1(6).Text & "元"
           .Recordset("日期") = Trim$(Text1(1).Text)
           .Recordset("存档合号") = Trim$(Text1(2).Text)
           .Recordset("本合序号") = Trim$(Text1(3).Text)
           .Recordset("备注") = Trim$(Text1(4).Text)
           .Recordset.Update
           
        End With
         Adodc6.Recordset.AddNew
             With Adodc6
               .Recordset("项目名称") = Trim$(DataCombo1.Text)
               .Recordset("单位") = Trim$(DataCombo2.Text)
              If Text1(5) <> "" Then .Recordset("完成工作量") = Text1(5).Text
               .Recordset("日期") = Trim$(Text1(1).Text)
               .Recordset.Update
            End With
         Adodc7.Recordset.AddNew
             With Adodc7
               .Recordset("项目名称") = Trim$(DataCombo1.Text)
               .Recordset("款项名称") = Trim$(DataCombo2.Text)
              If Text1(5) <> "" Then .Recordset("付款金额") = Text1(6).Text
               .Recordset("支付日期") = Trim$(Text1(1).Text)
               .Recordset("本合序号") = Trim$(Text1(3).Text)
               .Recordset.Update
            End With
         End If
  End If
End If
   Command1.SetFocus
End Sub


[ 本帖最后由 chen3523 于 2014-3-9 13:39 编辑 ]
#5
lowxiong2014-03-09 18:07
在str.open前加一句str.Type = adTypeBinary即可，如下：

  str.Type = adTypeBinary
  str.Open
1
©2025, BC-CN.NET
电脑版