Office中国论坛/Access中国论坛

标题: 帮忙看看这段新建记录代码有没有问题 [打印本页]

作者: yori2007 时间: 2012-6-12 09:46
标题: 帮忙看看这段新建记录代码有没有问题
本帖最后由 yori2007 于 2012-6-12 09:49 编辑

[attach]49336[/attach][attach]49335[/attach]不知道为什么，新建记录，新建以C开头的记录可以成功录入，而以V开头的不能录入。

Public coTBuyInvoice As New Collection

Public Sub NewTBuyInvoice()
On Error GoTo NewTBuyInvoice_Err
Dim mId As String
mId = InputBox("请输入发票号", "提示")
If mId & "" = "" Then
Exit Sub
End If
If DCount("InvoiceId", "tbTBuyInvoice", "InvoiceId='" & mId & "'") <> 0 Then
MsgBox "此发票号已经存在,请重新输入!", vbExclamation, "提示"
Exit Sub
End If

'新建发票
Dim rs As New ADODB.Recordset
rs.Open "tbTBuyInvoice", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
      With rs
         .AddNew
         ![InvoiceId] = mId
         ![BuildDate] = Date
         ![BuildMan] = DLookup("EmployeeId", "tbEmployee", "UserName='" & mUserName & "'")
         .Update
      End With
      rs.Close
      Set rs = Nothing
      DoCmd.Requery
'打开新记录编辑
      Dim fm As Form
      Set fm = New Form_fmTBuyInvoice  ‘打开新窗口
      fm.FilterOn = True
      fm.Filter = "Me.InvoiceId='" & mId & "'" ‘过滤
      fm.AllowAdditions = False  ‘表头不可编辑
      fm.Caption = "编辑发票" & mId
      fm.Visible = True
      coTBuyInvoice.Add Item:=fm, Key:=CStr(fm.Hwnd)
      Set fm = Nothing
NewTBuyInvoice_Exit:
Exit Sub
NewTBuyInvoice_Err:
MsgBox Err.Description
Resume NewTBuyInvoice_Exit
End Sub

作者: andymark 时间: 2012-6-12 13:35
搞不明白新建记录为啥需要Filter

作者: yori2007 时间: 2012-6-12 13:55
在新建的InvoiceId下建记录啊，关键问题是不知道coTBuyInvoice.Add Item:=fm, Key:=CStr(fm.Hwnd)
，这句话，有没有问题

作者: yori2007 时间: 2012-6-12 16:20
求关注啊

作者: yori2007 时间: 2012-6-12 18:32
求关注

作者: layaman_999 时间: 2012-6-12 19:29
If DCount("InvoiceId", "tbTBuyInvoice", "InvoiceId='" & mId & "'") <> 0 ThenDCount会降低效率,建议使用dlookup来检查
，其他问题你都没说，如果运行正常，就算了吧，等基础好了再来检查，毕竟每个人都编写习惯都不一样

作者: yori2007 时间: 2012-6-12 19:50
新增记录，以V开头的数据会弹出空白窗口，以C开头的没问题

作者: layaman_999 时间: 2012-6-12 20:47
      fm.FilterOn = True
      fm.Filter = "Me.InvoiceId='" & mId & "'" ‘过滤
调换一下顺序看看
fm.Filter = "Me.InvoiceId='" & mId & "'" ‘过滤
fm.FilterOn = True
==========
我觉得你的代码效率不高，可能这样要好点：
On Error GoTo NewTBuyInvoice_Err
Dim mId As String
mId = InputBox("请输入发票号", "提示")
If mId = "" Then Exit Sub

If Nz(DLookup("InvoiceId", "tbTBuyInvoice", "InvoiceId='" & mId & "'"), "") = mId Then
MsgBox "此发票号已经存在,请重新输入!", vbExclamation, "提示"
Exit Sub
End If

'新建发票
'====================
Dim StrSql As String '不清楚你的字段类型，'UserName'为文本, #BuildDate#为日期
StrSql = "insert into tbTBuyInvoice(InvoiceId,BuildDate,BuildMan) "
StrSql = StrSql & " select '" & mId & "', #" & BuildDate & "#, '" & DLookup("EmployeeId", "tbEmployee", "UserName='" & mUserName & "'") & "'"

CurrentProject.Connection.Execute (StrSql)

'打开新记录编辑
      Dim fm As Form
      Set fm = New Form_fmTBuyInvoice  '打开新窗口
      fm.RecordSource = "select * from tbTBuyInvoice where InvoiceId='" & mId & "'"
      fm.AllowAdditions = False  '表头不可编辑
      fm.Caption = "编辑发票" & mId
      fm.Visible = True
      coTBuyInvoice.Add Item:=fm, Key:=CStr(fm.Hwnd)
      Set fm = Nothing
NewTBuyInvoice_Exit:
Exit Sub
NewTBuyInvoice_Err:
MsgBox Err.Description
Resume NewTBuyInvoice_Exit

作者: layaman_999 时间: 2012-6-12 20:48
   fm.FilterOn = True
      fm.Filter = "Me.InvoiceId='" & mId & "'" ‘过滤
调换一下顺序看看
fm.Filter = "Me.InvoiceId='" & mId & "'" ‘过滤
fm.FilterOn = True
==========
我觉得你的代码效率不高，可能这样要好点：
On Error GoTo NewTBuyInvoice_Err
Dim mId As String
mId = InputBox("请输入发票号", "提示")
If mId = "" Then Exit Sub

If Nz(DLookup("InvoiceId", "tbTBuyInvoice", "InvoiceId='" & mId & "'"), "") = mId Then
MsgBox "此发票号已经存在,请重新输入!", vbExclamation, "提示"
Exit Sub
End If

'新建发票
'====================
Dim StrSql As String '不清楚你的字段类型，'UserName'为文本, #BuildDate#为日期
StrSql = "insert into tbTBuyInvoice(InvoiceId,BuildDate,BuildMan) "
StrSql = StrSql & " select '" & mId & "', #" & BuildDate & "#, '" & DLookup("EmployeeId", "tbEmployee", "UserName='" & mUserName & "'") & "'"

CurrentProject.Connection.Execute (StrSql)

'打开新记录编辑
      Dim fm As Form
      Set fm = New Form_fmTBuyInvoice  '打开新窗口
      fm.RecordSource = "select * from tbTBuyInvoice where InvoiceId='" & mId & "'"
      fm.AllowAdditions = False  '表头不可编辑
      fm.Caption = "编辑发票" & mId
      fm.Visible = True
      coTBuyInvoice.Add Item:=fm, Key:=CStr(fm.Hwnd)
      Set fm = Nothing
NewTBuyInvoice_Exit:
Exit Sub
NewTBuyInvoice_Err:
MsgBox Err.Description
Resume NewTBuyInvoice_Exit

作者: layaman_999 时间: 2012-6-12 20:50
回复需要审核？

作者: layaman_999 时间: 2012-6-12 20:57
Public coTBuyInvoice As New Collection

Public Sub NewTBuyInvoice()
   fm.FilterOn = True
      fm.Filter = "Me.InvoiceId='" & mId & "'" ‘过滤
调换一下顺序看看
fm.Filter = "Me.InvoiceId='" & mId & "'" ‘过滤
fm.FilterOn = True
==========
我觉得你的代码效率不高，可能这样要好点：
Public Sub NewTBuyInvoice()
On Error GoTo NewTBuyInvoice_Err
Dim mId As String
mId = InputBox("请输入发票号", "提示")
If mId = "" Then Exit Sub

If Nz(DLookup("InvoiceId", "tbTBuyInvoice", "InvoiceId='" & mId & "'"), "") = mId Then
MsgBox "此发票号已经存在,请重新输入!", vbExclamation, "提示"
Exit Sub
End If

'新建发票
'====================
Dim StrSql As String '不清楚你的字段类型，'UserName'为文本, #BuildDate#为日期
StrSql = "insert into tbTBuyInvoice(InvoiceId,BuildDate,BuildMan) "
StrSql = StrSql & " select '" & mId & "', #" & BuildDate & "#, '" & DLookup("EmployeeId", "tbEmployee", "UserName='" & mUserName & "'") & "'"

CurrentProject.Connection.Execute (StrSql)

'打开新记录编辑
      Dim fm As Form
      Set fm = New Form_fmTBuyInvoice  '打开新窗口
      fm.RecordSource = "select * from tbTBuyInvoice where InvoiceId='" & mId & "'"
      fm.AllowAdditions = False  '表头不可编辑
      fm.Caption = "编辑发票" & mId
      fm.Visible = True
      coTBuyInvoice.Add Item:=fm, Key:=CStr(fm.Hwnd)
      Set fm = Nothing
NewTBuyInvoice_Exit:
Exit Sub
NewTBuyInvoice_Err:
MsgBox Err.Description
Resume NewTBuyInvoice_Exit
end sub

作者: andymark 时间: 2012-6-12 21:23
楼主可以换一种思路
新增窗体时，清空所有数据，保存时才检测数据的完整性，唯一性

作者: layaman_999 时间: 2012-6-12 22:48
我觉得你的代码效率不高，可能这样要好点：
Public Sub NewTBuyInvoice()
On Error GoTo NewTBuyInvoice_Err
Dim mId As String
mId = InputBox("请输入发票号", "提示")
If mId = "" Then Exit Sub

If Nz(DLookup("InvoiceId", "tbTBuyInvoice", "InvoiceId='" & mId & "'"), "") = mId Then
MsgBox "此发票号已经存在,请重新输入!", vbExclamation, "提示"
Exit Sub
End If

'新建发票
'====================
Dim StrSql As String '不清楚你的字段类型，'UserName'为文本, #BuildDate#为日期
StrSql = "insert into tbTBuyInvoice(InvoiceId,BuildDate,BuildMan) "
StrSql = StrSql & " select '" & mId & "', #" & BuildDate & "#, '" & DLookup("EmployeeId", "tbEmployee", "UserName='" & mUserName & "'") & "'"

CurrentProject.Connection.Execute (StrSql)

'打开新记录编辑
      Dim fm As Form
      Set fm = New Form_fmTBuyInvoice  '打开新窗口
      fm.RecordSource = "select * from tbTBuyInvoice where InvoiceId='" & mId & "'"
      fm.AllowAdditions = False  '表头不可编辑
      fm.Caption = "编辑发票" & mId
      fm.Visible = True
      coTBuyInvoice.Add Item:=fm, Key:=CStr(fm.Hwnd)
      Set fm = Nothing
NewTBuyInvoice_Exit:
Exit Sub
NewTBuyInvoice_Err:
MsgBox Err.Description
Resume NewTBuyInvoice_Exit
end sub

作者: layaman_999 时间: 2012-6-12 22:49
On Error GoTo NewTBuyInvoice_Err
Dim mId As String
mId = InputBox("请输入发票号", "提示")
If mId = "" Then Exit Sub

If Nz(DLookup("InvoiceId", "tbTBuyInvoice", "InvoiceId='" & mId & "'"), "") = mId Then
MsgBox "此发票号已经存在,请重新输入!", vbExclamation, "提示"
Exit Sub
End If

'新建发票
'====================
Dim StrSql As String '不清楚你的字段类型，'UserName'为文本, #BuildDate#为日期
StrSql = "insert into tbTBuyInvoice(InvoiceId,BuildDate,BuildMan) "
StrSql = StrSql & " select '" & mId & "', #" & BuildDate & "#, '" & DLookup("EmployeeId", "tbEmployee", "UserName='" & mUserName & "'") & "'"

CurrentProject.Connection.Execute (StrSql)

'打开新记录编辑
      Dim fm As Form
      Set fm = New Form_fmTBuyInvoice  '打开新窗口
      fm.RecordSource = "select * from tbTBuyInvoice where InvoiceId='" & mId & "'"
      fm.AllowAdditions = False  '表头不可编辑
      fm.Caption = "编辑发票" & mId
      fm.Visible = True
      coTBuyInvoice.Add Item:=fm, Key:=CStr(fm.Hwnd)
      Set fm = Nothing
NewTBuyInvoice_Exit:
Exit Sub
NewTBuyInvoice_Err:
MsgBox Err.Description
Resume NewTBuyInvoice_Exit

作者: yori2007 时间: 2012-6-13 09:10
我现在纠结的是，为什么C可以，而V不可以啊

作者: yori2007 时间: 2012-6-13 09:28
晕，到现在才看到审核后的帖子，谢谢，我试试啊

作者: yori2007 时间: 2012-6-13 11:50
好像还是有错，我还是纠结于    Dim fm As Form
      Set fm = New Form_fmTBuyInvoice  '打开新窗口
      fm.RecordSource = "select * from tbTBuyInvoice where InvoiceId='" & mId & "'"
      fm.AllowAdditions = False  '表头不可编辑
      fm.Caption = "编辑发票" & mId
      fm.Visible = True
      coTBuyInvoice.Add Item:=fm, Key:=CStr(fm.Hwnd)
      Set fm = Nothing
这段代码有没有问题

作者: yori2007 时间: 2012-6-15 14:25
还没搞定，有没有人再帮我看看啊

作者: yori2007 时间: 2012-6-15 20:32
求关注

作者: layaman_999 时间: 2012-6-15 21:34
你先把（ fm.AllowAdditions = False ‘表头不可编辑）删了，看看是什么情况
然后看看以V开头的表头数据是否已经已经写入表中，如果没有写入的话，那你看看是不是字段类型不对还是字符长度不够。
==========
这些问题要自己多调试调试，看看究竟出问题在哪行代码

作者: andymark 时间: 2012-6-15 21:57
请上传示例好了

作者: yori2007 时间: 2012-6-16 09:32

layaman_999 发表于 2012-6-15 21:34
你先把（ fm.AllowAdditions = False ‘表头不可编辑）删了，看看是什么情况
然后看看以V开头的表头数据是 ...

数据没有写入，我再研究看看

作者: yori2007 时间: 2012-6-16 09:34

andymark 发表于 2012-6-15 21:57
请上传示例好了

公司很早以前做的adp啊，不知道什么时候出现了这种问题，现在还没发上传，正在改成mdb的，做个示例

作者: yori2007 时间: 2012-6-16 09:35

layaman_999 发表于 2012-6-15 21:34
你先把（ fm.AllowAdditions = False ‘表头不可编辑）删了，看看是什么情况
然后看看以V开头的表头数据是 ...

这个问题很奇怪，同样长度的字符串，一个以C开头，一个以V开头，其他都一样，竟然一个可以输入，一个不可以

作者: layaman_999 时间: 2012-6-16 10:17
原来是ADP啊
StrSql = StrSql & " select '" & mId & "', '" & BuildDate & "', '" & DLookup("EmployeeId", "tbEmployee", "UserName='" & mUserName & "'") & "'"

日期要把#改为'

作者: layaman_999 时间: 2012-6-16 10:23
Dim mId As String
mId = InputBox("请输入发票号", "提示")
If mId = "" Then Exit Sub

If Nz(DLookup("InvoiceId", "tbTBuyInvoice", "InvoiceId='" & mId & "'"), "") = mId Then
MsgBox "此发票号已经存在,请重新输入!", vbExclamation, "提示"
Exit Sub
End If

'新建发票
'====================
Dim StrSql As String '不清楚你的字段类型，'UserName'为文本, #BuildDate#为日期
StrSql = "insert into tbTBuyInvoice(InvoiceId,BuildDate,BuildMan) "
StrSql = StrSql & " select '" & mId & "', '" & BuildDate & "', '" & DLookup("EmployeeId", "tbEmployee", "UserName='" & mUserName & "'") & "'"

CurrentProject.Connection.Execute (StrSql)
exit sub'加个断点=====================
你先用上面的代码试验一下看能否写入表头，BuildDate的变量是从哪里来的，应该没问题吧

作者: yori2007 时间: 2012-6-16 10:36

layaman_999 发表于 2012-6-16 10:17
原来是ADP啊
StrSql = StrSql & " select '" & mId & "', '" & BuildDate & "', '" & DLookup("EmployeeId ...

好，我试试啊，谢谢啊

作者: yori2007 时间: 2012-6-18 08:40
再帮我看看

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)