frmsearch.frm

本系统是北京神兵广告有限公司的广告系统

    ff.Sections("section1").Controls.Item("label50").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label51").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label52").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label53").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label54").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label55").Caption = "未在厂商记录中找到相关记录"
Else

    ff.Sections("section1").Controls.Item("label47").Caption = rs2!logo
    ff.Sections("section1").Controls.Item("label48").Caption = rs2!bete
    ff.Sections("section1").Controls.Item("label49").Caption = rs2!content
    ff.Sections("section1").Controls.Item("label50").Caption = rs2!playtimename
    ff.Sections("section1").Controls.Item("label51").Caption = rs2!playtimeinfo
    ff.Sections("section1").Controls.Item("label52").Caption = rs2!playconntent
    ff.Sections("section1").Controls.Item("label53").Caption = rs2!ishaveplay
    ff.Sections("section1").Controls.Item("label54").Caption = rs2!content
        Dim rs3 As ADODB.Recordset
        Set rs3 = New Recordset
        sql3 = "select * from changshang where logo='" & rs2!logo & "' and content='" & rs2!content & "'"
        rs3.Open sql3, con, 1, 1
        If rs3.EOF Then
            ff.Sections("section1").Controls.Item("label55").Caption = "未在厂商记录中找到相关记录"
        Else
            ff.Sections("section1").Controls.Item("label55").Caption = rs3!Size
        End If

End If
    ff.Show 1

End Sub

Private Sub Command2_Click()
Dim sql As String
Dim str As String
Dim con As ADODB.Connection
Set con = New Connection
str = "provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\database.mdb"
con.Open str
Dim rs9 As ADODB.Recordset
Set rs9 = New Recordset
sql = "select * from changshang where logo='" & Combo2.Text & "'"
rs9.Open sql, con, 1, 1
Dim content9 As String
content9 = rs9!content
rs9.Close
Dim rs8 As ADODB.Recordset
Set rs8 = New Recordset
sql = "select hetong_no from toufang where logo='" & Combo2.Text & "' and content='" & content9 & "'"
rs8.Open sql, con, 1, 1
If rs8.EOF Then
msg = MsgBox("未找到该厂商的任何投放信息", 16, "错误")
Exit Sub
Else
shetong_no = rs8!hetong_no
End If





Dim rs As ADODB.Recordset
Set rs = New Recordset
sql = "select * from hetong where hetong_no='" & shetong_no & "'"
rs.Open sql, con, 1, 1


  Dim ff As New rpthetong
    Set ff.DataSource = rs
    ff.Caption = "神兵国际广告（北京）有限公司广告系统-合同号：" & rs!hetong_no & "报表"

    ff.Sections("section4").Controls.Item("label29").Caption = rs!hetong_no
    ff.Sections("section4").Controls.Item("label30").Caption = rs!xgxy_no
    ff.Sections("section1").Controls.Item("label31").Caption = rs!pingdao
    ff.Sections("section1").Controls.Item("label32").Caption = rs!leibie
    ff.Sections("section1").Controls.Item("label33").Caption = rs!playnumber
    ff.Sections("section1").Controls.Item("label34").Caption = rs!playtime
    ff.Sections("section1").Controls.Item("label35").Caption = rs!Money
    ff.Sections("section1").Controls.Item("label36").Caption = rs!othermoney
    ff.Sections("section1").Controls.Item("label37").Caption = rs!playmoney
    ff.Sections("section1").Controls.Item("label38").Caption = rs!sulemoney
    ff.Sections("section1").Controls.Item("label39").Caption = rs!bochumoney
    ff.Sections("section1").Controls.Item("label40").Caption = rs!weiyuemoney
    ff.Sections("section1").Controls.Item("label41").Caption = rs!allmoney
    ff.Sections("section1").Controls.Item("label42").Caption = rs!moneymoeny
    ff.Sections("section1").Controls.Item("label43").Caption = rs!qianyue_date
    ff.Sections("section1").Controls.Item("label44").Caption = rs!start_date
    ff.Sections("section1").Controls.Item("label45").Caption = rs!end_date
    ff.Sections("section1").Controls.Item("label46").Caption = rs!whoown
Dim rs2 As ADODB.Recordset
Set rs2 = New Recordset
sql = "select * from toufang where hetong_no='" & shetong_no & "'"
rs2.Open sql, con, 1, 1

If rs2.EOF Then
    ff.Sections("section1").Controls.Item("label47").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label48").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label49").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label50").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label51").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label52").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label53").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label54").Caption = "未在投放记录中找到相关记录"
    ff.Sections("section1").Controls.Item("label55").Caption = "未在厂商记录中找到相关记录"
Else

    ff.Sections("section1").Controls.Item("label47").Caption = rs2!logo
    ff.Sections("section1").Controls.Item("label48").Caption = rs2!bete
    ff.Sections("section1").Controls.Item("label49").Caption = rs2!content
    ff.Sections("section1").Controls.Item("label50").Caption = rs2!playtimename
    ff.Sections("section1").Controls.Item("label51").Caption = rs2!playtimeinfo
    ff.Sections("section1").Controls.Item("label52").Caption = rs2!playconntent
    ff.Sections("section1").Controls.Item("label53").Caption = rs2!ishaveplay
    ff.Sections("section1").Controls.Item("label54").Caption = rs2!content
        Dim rs3 As ADODB.Recordset
        Set rs3 = New Recordset
        sql3 = "select * from changshang where logo='" & rs2!logo & "' and content='" & rs2!content & "'"
        rs3.Open sql3, con, 1, 1
        If rs3.EOF Then
            ff.Sections("section1").Controls.Item("label55").Caption = "未在厂商记录中找到相关记录"
        Else
            ff.Sections("section1").Controls.Item("label55").Caption = rs3!Size
        End If

End If
    ff.Show 1

End Sub

Private Sub Command3_Click()
datestart = Calendar1.Value
dateend = Calendar2.Value
If dateend < datestart Then
msg = MsgBox("结束日期不能小于开始日期", 16, "错误")
Exit Sub
End If
Dim sql As String
sql = "select * from toufang where"
If Combo4.Text <> "" Then
sql = sql & " logo='" & Combo4.Text & "' and "
End If
sql = sql & " DateDiff('d', start_date,#" & datestart & "# )<=0 and "
sql = sql & " DateDiff('d', start_date,#" & dateend & "# )>=0 "
sql = sql & " order by start_date "
'msg = MsgBox(sql)
Dim str As String
Dim con As ADODB.Connection
Set con = New Connection
str = "provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\database.mdb"
con.Open str
Dim rs As ADODB.Recordset
Set rs = New Recordset
rs.Open sql, con, 1, 1
If rs.EOF Then
msg = MsgBox("没有当前选中日期之间的记录", 32, "信息")
Exit Sub
End If
  Dim ff As New rpttoufang
    Set ff.DataSource = rs
    ff.Caption = "神兵国际广告（北京）有限公司广告系统日期查询" & datestart & "-" & dateend & "报表"
     ff.Sections("section4").Controls.Item("label5").Caption = datestart
     ff.Sections("section4").Controls.Item("label6").Caption = dateend
     ff.Sections("section1").Controls.Item("text1").DataField = rs.Fields.Item(1).Name
    ff.Sections("section1").Controls.Item("text2").DataField = rs.Fields.Item(2).Name
    ff.Sections("section1").Controls.Item("text3").DataField = rs.Fields.Item(3).Name
    ff.Sections("section1").Controls.Item("text4").DataField = rs.Fields.Item(4).Name
    ff.Sections("section1").Controls.Item("text5").DataField = rs.Fields.Item(5).Name
    ff.Sections("section1").Controls.Item("text6").DataField = rs.Fields.Item(6).Name
    ff.Sections("section1").Controls.Item("text7").DataField = rs.Fields.Item(7).Name
    ff.Sections("section1").Controls.Item("text8").DataField = rs.Fields.Item(9).Name
    ff.Sections("section1").Controls.Item("text9").DataField = rs.Fields.Item(10).Name
    ff.Sections("section1").Controls.Item("text10").DataField = rs.Fields.Item(13).Name
    
    ff.Show 1
End Sub

Private Sub Command4_Click()
datestart = Calendar1.Value
dateend = Calendar2.Value
'msg = MsgBox(datestart)
'msg = MsgBox(DateDiff("d", datestart, #5/3/2003#))
'msg = MsgBox(DateDiff("d", dateend, #5/3/2003#))


If dateend < datestart Then
msg = MsgBox("结束日期不能小于开始日期", 16, "错误")
Exit Sub
End If
Dim sql As String
sql = "select * from toufang where"
If Combo4.Text <> "" Then
sql = sql & " logo='" & Combo4.Text & "' and "
End If
sql = sql & " DateDiff('d', end_date,#" & datestart & "# )<=0 and "
sql = sql & " DateDiff('d', end_date,#" & dateend & "# )>=0 "
sql = sql & " order by end_date  "
'msg = MsgBox(sql)
Dim str As String
Dim con As ADODB.Connection
Set con = New Connection
str = "provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\database.mdb"
con.Open str
Dim rs As ADODB.Recordset
Set rs = New Recordset
rs.Open sql, con, 1, 1
If rs.EOF Then
msg = MsgBox("没有当前选中日期之间的记录", 32, "信息")
Exit Sub
End If
  Dim ff As New rpttoufang
    Set ff.DataSource = rs
    ff.Caption = "神兵国际广告（北京）有限公司广告系统日期查询" & datestart & "-" & dateend & "报表"
     ff.Sections("section4").Controls.Item("label5").Caption = datestart
     ff.Sections("section4").Controls.Item("label6").Caption = dateend
     ff.Sections("section1").Controls.Item("text1").DataField = rs.Fields.Item(1).Name
    ff.Sections("section1").Controls.Item("text2").DataField = rs.Fields.Item(2).Name
    ff.Sections("section1").Controls.Item("text3").DataField = rs.Fields.Item(3).Name
    ff.Sections("section1").Controls.Item("text4").DataField = rs.Fields.Item(4).Name
    ff.Sections("section1").Controls.Item("text5").DataField = rs.Fields.Item(5).Name
    ff.Sections("section1").Controls.Item("text6").DataField = rs.Fields.Item(6).Name
    ff.Sections("section1").Controls.Item("text7").DataField = rs.Fields.Item(7).Name
    ff.Sections("section1").Controls.Item("text8").DataField = rs.Fields.Item(9).Name
    ff.Sections("section1").Controls.Item("text9").DataField = rs.Fields.Item(10).Name
    ff.Sections("section1").Controls.Item("text10").DataField = rs.Fields.Item(13).Name
    
    ff.Show 1
End Sub

Private Sub Command5_Click()
datestart = Calendar1.Value
dateend = Calendar2.Value
'msg = MsgBox(datestart)
'msg = MsgBox(DateDiff("d", datestart, #5/1/2003#))
'msg = MsgBox(DateDiff("d", dateend, #5/1/2003#))


If dateend < datestart Then
msg = MsgBox("结束日期不能小于开始日期", 16, "错误")
Exit Sub
End If
Dim sql As String
sql = "select * from toufang where"
If Combo4.Text <> "" Then
sql = sql & " logo='" & Combo4.Text & "' and "
End If
sql = sql & " DateDiff('d', qianyue_date,#" & datestart & "# )<=0 and "
sql = sql & " DateDiff('d', qianyue_date,#" & dateend & "# )>=0 "
sql = sql & " order by qianyue_date"
'msg = MsgBox(sql)
Dim str As String
Dim con As ADODB.Connection
Set con = New Connection
str = "provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\database.mdb"
con.Open str
Dim rs As ADODB.Recordset
Set rs = New Recordset
rs.Open sql, con, 1, 1
If rs.EOF Then
msg = MsgBox("没有当前选中日期之间的记录", 32, "信息")
Exit Sub
End If
  Dim ff As New rpttoufang
    Set ff.DataSource = rs
    ff.Caption = "神兵国际广告（北京）有限公司广告系统日期查询" & datestart & "-" & dateend & "报表"
     ff.Sections("section4").Controls.Item("label5").Caption = datestart
     ff.Sections("section4").Controls.Item("label6").Caption = dateend
     ff.Sections("section1").Controls.Item("text1").DataField = rs.Fields.Item(1).Name
    ff.Sections("section1").Controls.Item("text2").DataField = rs.Fields.Item(2).Name
    ff.Sections("section1").Controls.Item("text3").DataField = rs.Fields.Item(3).Name
    ff.Sections("section1").Controls.Item("text4").DataField = rs.Fields.Item(4).Name
    ff.Sections("section1").Controls.Item("text5").DataField = rs.Fields.Item(5).Name
    ff.Sections("section1").Controls.Item("text6").DataField = rs.Fields.Item(6).Name
    ff.Sections("section1").Controls.Item("text7").DataField = rs.Fields.Item(7).Name
    ff.Sections("section1").Controls.Item("text8").DataField = rs.Fields.Item(9).Name
    ff.Sections("section1").Controls.Item("text9").DataField = rs.Fields.Item(10).Name
    ff.Sections("section1").Controls.Item("text10").DataField = rs.Fields.Item(13).Name
    
    ff.Show 1
End Sub

Private Sub Command6_Click()
Unload Me
frmmain.Show

End Sub

Private Sub Form_Load()
Calendar2.Year = Year(Now)
Calendar2.Month = Month(Now)
Calendar2.Day = Day(Now)
Calendar1.Year = Year(Now)
Calendar1.Month = Month(Now)
Calendar1.Day = Day(Now)
Dim sql As String
Dim str As String
Dim con As ADODB.Connection
Set con = New Connection
str = "provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\database.mdb"
con.Open str
Dim rs As ADODB.Recordset
Set rs = New Recordset
sql = "select  distinct hetong_no from hetong "
rs.Open sql, con, 1, 1

If Not rs.EOF Then

Combo1.Text = rs!hetong_no
Else
msg = MsgBox("当前无任何合同记录，无法进行查询", 16, "错误")
Me.Hide
frmmain.Show
Exit Sub
End If

Do While Not rs.EOF
Combo1.AddItem (rs!hetong_no)
rs.MoveNext
Loop

rs.Close

Dim rs2 As ADODB.Recordset
Set rs2 = New Recordset
sql = "select distinct logo from changshang "
rs2.Open sql, con, 1, 1

If Not rs2.EOF Then

Combo2.Text = rs2!logo
Else
msg = MsgBox("当前无任何合同信息，无法使用查询")

Load frmmain
frmmain.Show
Me.Hide
Exit Sub
End If

Do While Not rs2.EOF
Combo2.AddItem (rs2!logo)
Combo4.AddItem (rs2!logo)
rs2.MoveNext
Loop
con.Close
Set con = Nothing

End Sub


Private Sub Form_Unload(Cancel As Integer)
frmmain.Show

End Sub