社区

京东店铺
淘宝店铺
当当店铺
拼多多店铺

APP下载

扫描下载官方APP

VIP会员

VB答疑区

+关注

已有22人关注

+发表新帖

所属版块： VB答疑区

freefly

学分:0

+关注

私信

立即签到

版块推荐

关于水晶报表在VB中访问带有密码的ACESS数据库，提示密码无效！

发表在VB答疑区 2008-03-21

是否精华是否

版块置顶: 是否

各位高手，我最近在做一个数据库的小系统，采用VB+Access来做，数据库加了密码。如果单独用水晶报表做能访问；我的数据库访问方法（如果单独访问也正常）是：      ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\lsgx.mdb;jet oledb:database password=" & CStr(databasepassword) & ";Persist Security Info=False" 结合在一起，即在VB中用水晶报表访问带有密码的数据库就提示：密码无效[em1]

分享到：

关注

支持(0)

反对(0)

精彩评论 4

Amy

学分：0 LV1

+关注

私信

2008-03-22

沙发

您好 !
ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\lsgx.mdb;jet oledb:database password=" & CStr(databasepassword) & ";Persist Security Info=False" 1、请确定您的字符串(databasepassword)是否传过来了。
2、请确定databasepassword是否被定义的是全局变量。
如果确定该字符串已传过来,请把其余代码发给我们,我们会尽快为您解决问题.

支持(0)

反对(0)

freefly

学分：0 LV1

+关注

私信

2008-03-23

板凳

'查询代码
Public Report As New dsrXtreme Public Function ConnectString() _    As String    Const DatabasePassword = 888888
'returns a DB ConnectString    'ConnectString = "FileDSN=xtreme.dsn"       'ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\xtreme.mdb;Persist Security Info=False"       'ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\lsgx.mdb;Persist Security Info=False"       'ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\lsgx.mdb;jet oledb:database password=751219" & ";Persist Security Info=False"      ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\lsgx.mdb;jet oledb:database password=" & CStr(DatabasePassword) & ";Persist Security Info=False" MsgBox ConnectString End Function Public Function ExecuteSQL(ByVal SQL _    As String, MsgString As String) _    As ADODB.Recordset 'executes SQL and returns Recordset    Dim cnn As ADODB.Connection    Dim rst As ADODB.Recordset    Dim sTokens() As String       On Error GoTo ExecuteSQL_Error       sTokens = Split(SQL)    Set cnn = New ADODB.Connection    cnn.Open ConnectString    If InStr("INSERT,DELETE,UPDATE,EXECUTE", _       UCase$(sTokens(0))) Then       cnn.Execute (SQL)       MsgString = sTokens(0) & _          " query successful"    Else       Set rst = New ADODB.Recordset       rst.Open Trim$(SQL), cnn, _          adOpenKeyset, _          adLockOptimistic       'rst.MoveLast     'get RecordCount       Set ExecuteSQL = rst       MsgString = "查询到" & rst.RecordCount & _          " 条记录 "    End If ExecuteSQL_Exit:    Set rst = Nothing    Set cnn = Nothing    Exit Function       ExecuteSQL_Error:    MsgString = "查询错误: " & _       Err.Description    Resume ExecuteSQL_Exit End Function '至于水晶那部分
Private Sub cmdCancel_Click()     Unload Me End Sub
Private Sub cmdOK_Click()     Dim txtFromD As String     Dim txtToD As String
  '  On Error GoTo cmdOK_Click_Error         Dim strSelectionFormula As String     Dim strSubHeading As String         txtFromD = Trim(Combo1) & "-" & Trim(Combo2) & "-" & Trim(Combo3)     txtToD = Trim(Combo4) & "-" & Trim(Combo5) & "-" & Trim(Combo6)             'Validate controls     If Not IsDate(txtFromD) Then         MsgBox "请选择报表数据开始日期!", vbOKOnly + vbCritical, "报表设计"         Combo1.SetFocus         Exit Sub     End If  'IsNull(txtFromDate)...
    If Not IsDate(txtToD) Then         MsgBox "请选择报表数据结束日期!", vbOKOnly + vbCritical, "报表设计"         Combo4.SetFocus         Exit Sub     End If  'IsNull(txtFromDate)...
     If OptEmail And txtAddress = "" Then         MsgBox "请输入电子邮件地址", vbOKOnly + vbCritical, "报表设计"         txtAddress.SetFocus         Exit Sub     End If  'OptEmail And IsNull(txtAddress)         If CDate(txtFromD) > CDate(txtToD) Then         MsgBox "结束日期必须不早于开始时间", vbOKOnly + vbCritical, "报表设计"         Combo4.SetFocus         Exit Sub     End If  'CDate(txtFromDate) > CDate(txtToDate)         Screen.MousePointer = vbHourglass     Report.DiscardSavedData 'required for consistent results         'Supply record selection based on dates     'strSelectionFormula = "{Orders.Order Date} in #" & _     'txtFromD & "# to #" & txtToD & "#"      strSelectionFormula = "{rcb.rq} in #" & _     txtFromD & "# to #" & txtToD & "#" '要求表字段类型为日期/时间     '{rcb.cph} in "4" to "京A32345"    '     strSelectionFormula = "{rcb.rq} in " & _     'txtFromD & " to " & txtToD  '要求表字段类型为日期/时间
     'txtFromDate & "# to #" & txtToDate & "#"         Report.RecordSelectionFormula = strSelectionFormula          'Set @Order + Tax formula     Dim FormulaField As CRAXDRT.FormulaFieldDefinition     Set FormulaField = Report.FormulaFields.GetItemByName("jz")        ' If txtTaxRate = "" Then         'Report.FormulaFields(1).Text = "{Orders.Order Amount}"         FormulaField.Text = "{rcb.mz}-" & "{rcb.pz}"     'Else         'Report.FormulaFields(1).Text = "{Orders.Order Amount} * " & Str(txtTaxRate / 100 + 1)      '   FormulaField.Text = "{Orders.Order Amount} * " & Str(txtTaxRate / 100 + 1)     'End If  'txtTaxRate = ""         'Set grouping     If cboGroupBy = "季度" Then         Report.Areas("GH").GroupConditionField = _             Report.Database.Tables(1).Fields(2)  'Orders.Order Date         Report.Areas("GH").GroupCondition = crGCQuarterly '此处可以选择每日等的参数     Else         Report.Areas("GH").GroupConditionField = _             Report.Database.Tables(1).Fields(16)  'Customer.Customer Name         Report.Areas("GH").GroupCondition = crGCAnyValue     End If  'cboGroupBy = "Quarter"     'Set parameter value     'Alternative method is to format details section within VB     'If txtHighlight = "" Then     '    Report.ParameterFields(1).AddCurrentValue (0)     'Else     '    Report.ParameterFields(1).AddCurrentValue (Val(txtHighlight))     'End If  'txtHighlight = ""         'Set grouping     Report.subHeading.SetText ("aaaa")             'Hide/show sections         With Report         If chkSummary Then             .Areas("D").HideForDrillDown = True             .phb.Suppress = True             .Areas("GH1").HideForDrillDown = True             .gh1a.Suppress = False             .gh1b.Suppress = False         Else             .Areas("D").HideForDrillDown = False             .phb.Suppress = False             .Areas("GH1").HideForDrillDown = False             .gh1a.Suppress = False             .gh1b.Suppress = True         End If  'chkSummary     End With    'Report
     If optPreview Then      frmViewer.Show     End If         Screen.MousePointer = vbDefault     Exit Sub     cmdOK_Click_Error:     Screen.MousePointer = vbDefault     Select Case Err.Number         Case -2147190889             MsgBox "Report Cancelled", vbInformation, "Xtreme Order Report"         Case -2147190908             MsgBox "Invalid E-Mail address or other e-mail problem", vbCritical, "Xtreme Order Report"             txtAddress.SetFocus         Case Else             MsgBox "Error " & Err.Number & " - " & Err.Description, vbCritical, "Xtreme Order Report"     End Select  'Case Err.Number         End Sub
Private Sub Form_Load()     Dim mrc As ADODB.Recordset     Dim txtSQL As String     Dim MsgTxt As String     Dim i As Integer     Report.Database.Tables(1).ConnectBufferString = ConnectString     'txtFromDate = Format(#1/1/2001#, "Short Date")     'txtToDate = Format(#12/31/2001#, "Short Date")     cboGroupBy.Text = "季度"        ' txtSQL = "select distinct year(订单日期) from 订单"    txtSQL = "select distinct year(rq) from rcb"     Set mrc = ExecuteSQL(txtSQL, MsgTxt)         If Not mrc.EOF Then         Do While Not mrc.EOF             Combo1.AddItem mrc.Fields(0)             Combo4.AddItem mrc.Fields(0)             mrc.MoveNext         Loop     End If         mrc.Close         For i = 1 To 12         Combo2.AddItem i         Combo5.AddItem i     Next i         For i = 1 To 31         Combo3.AddItem i         Combo6.AddItem i     Next i         Combo1.ListIndex = 0     Combo4.ListIndex = 0     Combo2.ListIndex = 0     Combo5.ListIndex = 11     Combo3.ListIndex = 0     Combo6.ListIndex = 0     End Sub
Private Sub Form_Unload(Cancel As Integer)     Set Report = Nothing End Sub
Private Sub OptEmail_Click()     txtAddress.Enabled = True     lblAddress.Enabled = True End Sub
Private Sub optPreview_Click()     txtAddress.Enabled = False     lblAddress.Enabled = False End Sub
Private Sub OptPrint_Click()     txtAddress.Enabled = False     lblAddress.Enabled = False End Sub
 Private Sub txtAddress_GotFocus()     txtAddress.SelStart = 0     txtAddress.SelLength = Len(txtAddress) End Sub
Private Sub txtFromDate_GotFocus()     txtFromDate.SelStart = 0     txtFromDate.SelLength = Len(txtFromDate) End Sub
Private Sub txtFromDate_LostFocus()     txtFromDate = Format(txtFromDate, "Short Date") End Sub
Private Sub txtHighlight_GotFocus()     txtHighlight.SelStart = 0     txtHighlight.SelLength = Len(txtHighlight) End Sub
Private Sub txtHighlight_LostFocus()     If txtHighlight <> "" Then         txtHighlight = Val(txtHighlight)     End If  'txtHighlight <> "" End Sub
Private Sub txtTaxRate_GotFocus()     txtTaxRate.SelStart = 0     txtTaxRate.SelLength = Len(txtTaxRate) End Sub
Private Sub txtTaxRate_LostFocus()     If txtTaxRate <> "" Then         txtTaxRate = Val(txtTaxRate)     End If  'txtTaxRate <> "" End Sub
Private Sub txtToDate_GotFocus()     txtToDate.SelStart = 0     txtToDate.SelLength = Len(txtToDate) End Sub
Private Sub txtToDate_LostFocus()     txtToDate = Format(txtToDate, "Short Date") End Sub 
打开水晶报表建立的窗体然后在"FROM_LOAD"中加入下面的语句,并在"="号后面写上登录数据库使用的连接字串,用户名与密码写在登录字串中 Report.Database.Tables(1).ConnectBufferString ="........."
为什么我加了代码还是说我“未指定数据库”呢？

支持(0)

反对(0)

freefly

学分：0 LV1

+关注

私信

2008-03-23

地板

我用过 ACCESS/EXCEL（DAO）创建实验，另外也用 JET OLEDB 4。0 OLE DB（ADO）PROVIDER 试验。在CRYSTAL中均正常创建连接。就是到了窗体要显示报表之前提示：密码无效。

支持(0)

反对(0)

Lemon