# Re: 请问怎样将一个recordset的资料转成DBF档?

Posted by Ronald on November 02, 1998 at 17:10:18:

In Reply to: 请问怎样将一个recordset的资料转成DBF档? posted by kkcheung on October 31, 1998 at 11:28:06:

: 请问怎样将一个recordset的资料转成DBF档?
: 我指的方法是在程式中转换.
: 另在VB里,怎样将AA="19981023"文字串转成日期,类似FOXPRO的CTOD().
: 谢谢大家!
>>问题一
>>参看vb 5.0 线上说明 找关键字 dbase 或异质资料库
>>问题二
>>DateSerial(left(aa,4),mid(aa,5,2),mid(aa,7,2))
>>或 参看说明 Format()函数
>>或 送你一个自己写的日期格式检验并转换模组

'****日期格式检验并转换模组****
'说明:本模组专为含有日期内容文字盒检验设计
'使用方式:
'chkdate TextBox
'日期格式经过确认后,正确将传递其一公用变数 datechk=1,
'并自动将对象文字盒中之日期资料变更为 yyyy/mm/dd 格式
'错误将传递 datechk=0
'本模组使对象文字盒接受下列五种资料格式:
'yyyy/mm/dd 以表示 yyyy/mm/dd
'yyyy/m/dd 以表示个位数月份 如 1971/9/31
'yyyy/mm/d 以表示个位数日期 如 1971/09/4
'yyyy/m/d 以表示月份及日期均为个位数 如 1971/9/2
'yyyymmdd 以表示 yyyy/mm/dd
'所有格式经过验证通过,将自动转换对象文字盒内容为 yyyy/mm/dd 格式

Sub chkdate(chktxt As TextBox)
If chktxt.Text = "" Then
datechk = 1
Exit Sub
End If
If IsNumeric(Left(chktxt.Text, 4)) <> True Then
Call errinfo
Exit Sub
End If

If Mid(chktxt.Text, 1, 2) <> "19" And Mid(chktxt.Text, 1, 2) <> "20" Then
MsgBox "年格式为19XX,或者 20XX!"
datechk = 0
Exit Sub
End If

If Len(chktxt.Text) = 10 Then

If Mid(chktxt.Text, 5, 1) <> "/" Or Mid(chktxt.Text, 8, 1) <> "/" Then
Call errinfo
Exit Sub
End If
If IsNumeric(Mid(chktxt.Text, 6, 2)) <> True Or IsNumeric(Mid(chktxt.Text, 6, 2)) <> True Or IsNumeric(Mid(chktxt.Text, 9, 2)) <> True Then
Call errinfo
Exit Sub
End If

If Val(Mid(chktxt.Text, 6, 1)) > 1 Then
Call errinfo
Exit Sub
End If

If Val(Mid(chktxt.Text, 6, 1)) = 1 And Val(Mid(chktxt.Text, 7, 1)) > 2 Then
Call errinfo
Exit Sub
End If

If Val(Mid(chktxt.Text, 9, 1)) > 3 Then
Call errinfo
Exit Sub
End If

If Val(Mid(chktxt.Text, 9, 1)) = 3 And Val(Mid(chktxt.Text, 10, 1)) > 1 Then
Call errinfo
Exit Sub
End If
datechk = 1
Exit Sub
ElseIf Len(chktxt.Text) = 8 And Mid(chktxt.Text, 5, 1) <> "/" Then

If IsNumeric(chktxt.Text) <> True Or Len(chktxt.Text) <> 8 Then
Call errinfo
Exit Sub
End If

If Val(Mid(chktxt.Text, 5, 1)) > 1 Then
Call errinfo
Exit Sub
End If

If Val(Mid(chktxt.Text, 5, 1)) = 1 And Val(Mid(chktxt.Text, 6, 1)) > 2 Then
Call errinfo
Exit Sub
End If

If Val(Mid(chktxt.Text, 7, 1)) > 3 Then
Call errinfo
Exit Sub
End If

If Val(Mid(chktxt.Text, 7, 1)) = 3 And Val(Mid(chktxt.Text, 8, 1)) > 1 Then
Call errinfo
Exit Sub
End If

chktxt.Text = Left(chktxt.Text, 4) & "/" & Mid(chktxt, 5, 2) & "/" & Mid(chktxt, 7, 2)
datechk = 1
Exit Sub
ElseIf Len(chktxt.Text) = 8 And Mid(chktxt.Text, 5, 1) = "/" Then

If IsNumeric(Mid(chktxt.Text, 6, 1)) <> True Then
Call errinfo
Exit Sub
End If
If Mid(chktxt.Text, 7, 1) = "/" And Mid(chktxt.Text, 6, 1) = "0" Then
Call errinfo
Exit Sub
End If

chktxt.Text = Left(chktxt.Text, 4) & "/" & "0" & Mid(chktxt, 6, 1) & "/" & Mid(chktxt, 8, 2)
datechk = 1
Exit Sub
ElseIf Len(chktxt.Text) = 9 And Mid(chktxt.Text, 5, 1) = "/" And Mid(chktxt.Text, 7, 1) = "/" Then

If IsNumeric(Mid(chktxt.Text, 6, 1)) <> True Then
Call errinfo
Exit Sub
End If
If IsNumeric(Mid(chktxt.Text, 8, 2)) <> True Then
Call errinfo
Exit Sub
End If
If Val(Mid(chktxt.Text, 8, 2)) > 31 Then
Call errinfo
Exit Sub
End If
chktxt.Text = Left(chktxt.Text, 4) & "/" & "0" & Mid(chktxt, 6, 1) & "/" & Mid(chktxt, 8, 2)
datechk = 1
Exit Sub

ElseIf Len(chktxt.Text) = 9 And Mid(chktxt.Text, 5, 1) = "/" And Mid(chktxt.Text, 8, 1) = "/" Then
If IsNumeric(Mid(chktxt.Text, 6, 2)) <> True Then
Call errinfo
Exit Sub
End If
If IsNumeric(Mid(chktxt.Text, 9, 1)) <> True Or Mid(chktxt, 9, 1) = "0" Then
Call errinfo
Exit Sub
End If
chktxt.Text = Left(chktxt.Text, 4) & "/" & Mid(chktxt, 6, 2) & "/" & "0" & Mid(chktxt, 9, 2)
datechk = 1
Exit Sub
Else
Call errinfo
Exit Sub
End If

End Sub

Function errinfo()
MsgBox "日期格式错误!" + Chr$(13) + Chr$(10) + _
"提示:" + Chr$(13) + Chr$(10) + _
"请输入如右格式 19711026 以表示 1971/10/26"
datechk = 0
End Function

Follow Ups: