Dim chang As Boolean
Dim mydata As Database
Dim rs As Recordset
Function filecontent(FileName As String) As String
Dim FileNo As Integer
Dim FileString As String
FileNo = FreeFile
Open FileName For Binary As #FileNo
FileString = Space(FileLen(FileName))
Get #FileNo, , FileString
Close #FileNofilecontent = FileString
End Function
Private Sub c01_Click()
If ps = "" Then
MsgBox ("请填写完整信息后再操作本项!")
Else
'
End If
End Sub
Private Sub jc(jc_a)
If username = "" Or xb = "" Or fg = "" Or ps = "" Or bh = "" Or ys = "" Then
MsgBox ("请填好表格内容后才能预览!")
Else
MsgBox ("艺家设计")
End If
End SubPrivate Sub c02_Click()
If bh = "" Or username = "" Then
MsgBox ("请填写完整信息后再操作本项!")
Else
text1.Text = filecontent(App.Path & "\doc1\" & fg & ".htm")
text1.Text = Replace(text1.Text, "$r$username$f$", username)
text1.Text = Replace(text1.Text, "$r$bh$f$", bh)
text1.Text = Replace(text1.Text, "$r$time$f$", Date$)
If Dir(App.Path & "\user\" & bh & username, vbDirectory) = "" Then
MkDir App.Path & "\user\" & bh & username
End If
Open App.Path & "\user\" & bh & username & "\" & "款式风格分析方案.htm" For Output As #1
Print #1, text1.Text
Close #1
Dim RetVal
RetVal = Shell("C:\Program Files\Internet Explorer\IEXPLORE.EXE " & App.Path & "\user\" & bh & username & "\" & "款式风格分析方案.htm", 1)
MsgBox "成功生成!文件信息:" & App.Path & "\user\" & bh & username & "\" & "款式风格分析方案.htm"
End If
End SubPrivate Sub Command5_Click()
If chang Then
rs.AddNew
rs("username") = username
rs("xb") = xb
rs("fg") = fg
rs("ps") = ps
rs("bh") = bh
rs("ys") = ys
MsgBox ("添加成功")
rs.Update
Else
MsgBox ("您没有进行任何资料的添加!")
End If
End SubPrivate Sub Form_Load()
Dim mydata As Database
Set mydata = OpenDatabase(App.Path & "\dbf1.mdb")
Set rs = mydata.OpenRecordset("user")
End Sub
Private Sub fg_Change()
chang = True
End SubPrivate Sub Label2_Click()
End
End SubPrivate Sub ps_Change()
chang = True
End Sub
Private Sub username_Change()
chang = True
End SubPrivate Sub username1_Change()End SubPrivate Sub xb_Change()
chang = True
End SubPrivate Sub ys_Change()
chang = True
End Sub提示需要对象424,请高手指导一下!